Released SD*5.3*812 SEQ #670 Extracted from mail message **KIDS**:SD*5.3*812^ **INSTALL NAME** SD*5.3*812 "BLD",11900,0) SD*5.3*812^SCHEDULING^0^3220511^y "BLD",11900,1,0) ^^2^2^3220215^^ "BLD",11900,1,1,0) The description of this build can be found in the National Patch Module "BLD",11900,1,2,0) under SD*5.3*812. "BLD",11900,4,0) ^9.64PA^^ "BLD",11900,6) 2 "BLD",11900,6.3) 17 "BLD",11900,"ABPKG") n "BLD",11900,"INID") ^n "BLD",11900,"INIT") EN^SD53P812 "BLD",11900,"KRN",0) ^9.67PA^1.5^25 "BLD",11900,"KRN",.4,0) .4 "BLD",11900,"KRN",.401,0) .401 "BLD",11900,"KRN",.402,0) .402 "BLD",11900,"KRN",.403,0) .403 "BLD",11900,"KRN",.5,0) .5 "BLD",11900,"KRN",.84,0) .84 "BLD",11900,"KRN",1.5,0) 1.5 "BLD",11900,"KRN",1.6,0) 1.6 "BLD",11900,"KRN",1.61,0) 1.61 "BLD",11900,"KRN",1.62,0) 1.62 "BLD",11900,"KRN",3.6,0) 3.6 "BLD",11900,"KRN",3.8,0) 3.8 "BLD",11900,"KRN",9.2,0) 9.2 "BLD",11900,"KRN",9.8,0) 9.8 "BLD",11900,"KRN",9.8,"NM",0) ^9.68A^5^5 "BLD",11900,"KRN",9.8,"NM",1,0) SDTMPUT0^^0^B69402969 "BLD",11900,"KRN",9.8,"NM",2,0) SDTMPSTN^^0^B15359096 "BLD",11900,"KRN",9.8,"NM",3,0) SDUNC^^0^B25544291 "BLD",11900,"KRN",9.8,"NM",4,0) SDHL7CON^^0^B97694380 "BLD",11900,"KRN",9.8,"NM",5,0) SDTMPHLA^^0^B112717895 "BLD",11900,"KRN",9.8,"NM","B","SDHL7CON",4) "BLD",11900,"KRN",9.8,"NM","B","SDTMPHLA",5) "BLD",11900,"KRN",9.8,"NM","B","SDTMPSTN",2) "BLD",11900,"KRN",9.8,"NM","B","SDTMPUT0",1) "BLD",11900,"KRN",9.8,"NM","B","SDUNC",3) "BLD",11900,"KRN",19,0) 19 "BLD",11900,"KRN",19,"NM",0) ^9.68A^8^7 "BLD",11900,"KRN",19,"NM",2,0) SD TELE INQ^^0 "BLD",11900,"KRN",19,"NM",3,0) SD TELE STOP CODE^^0^ "BLD",11900,"KRN",19,"NM",4,0) SD TELE CLN UPDATE^^0^ "BLD",11900,"KRN",19,"NM",5,0) SD PROVIDER ADD/EDIT^^0^ "BLD",11900,"KRN",19,"NM",6,0) SD DISPLAY AVAIL REPORT^^0^ "BLD",11900,"KRN",19,"NM",7,0) SD MISSING STATION NUMBER^^0 "BLD",11900,"KRN",19,"NM",8,0) SD TELE TOOLS^^0 "BLD",11900,"KRN",19,"NM","B","SD DISPLAY AVAIL REPORT",6) "BLD",11900,"KRN",19,"NM","B","SD MISSING STATION NUMBER",7) "BLD",11900,"KRN",19,"NM","B","SD PROVIDER ADD/EDIT",5) "BLD",11900,"KRN",19,"NM","B","SD TELE CLN UPDATE",4) "BLD",11900,"KRN",19,"NM","B","SD TELE INQ",2) "BLD",11900,"KRN",19,"NM","B","SD TELE STOP CODE",3) "BLD",11900,"KRN",19,"NM","B","SD TELE TOOLS",8) "BLD",11900,"KRN",19.1,0) 19.1 "BLD",11900,"KRN",101,0) 101 "BLD",11900,"KRN",409.61,0) 409.61 "BLD",11900,"KRN",771,0) 771 "BLD",11900,"KRN",779.2,0) 779.2 "BLD",11900,"KRN",870,0) 870 "BLD",11900,"KRN",8989.51,0) 8989.51 "BLD",11900,"KRN",8989.52,0) 8989.52 "BLD",11900,"KRN",8993,0) 8993 "BLD",11900,"KRN",8994,0) 8994 "BLD",11900,"KRN","B",.4,.4) "BLD",11900,"KRN","B",.401,.401) "BLD",11900,"KRN","B",.402,.402) "BLD",11900,"KRN","B",.403,.403) "BLD",11900,"KRN","B",.5,.5) "BLD",11900,"KRN","B",.84,.84) "BLD",11900,"KRN","B",1.5,1.5) "BLD",11900,"KRN","B",1.6,1.6) "BLD",11900,"KRN","B",1.61,1.61) "BLD",11900,"KRN","B",1.62,1.62) "BLD",11900,"KRN","B",3.6,3.6) "BLD",11900,"KRN","B",3.8,3.8) "BLD",11900,"KRN","B",9.2,9.2) "BLD",11900,"KRN","B",9.8,9.8) "BLD",11900,"KRN","B",19,19) "BLD",11900,"KRN","B",19.1,19.1) "BLD",11900,"KRN","B",101,101) "BLD",11900,"KRN","B",409.61,409.61) "BLD",11900,"KRN","B",771,771) "BLD",11900,"KRN","B",779.2,779.2) "BLD",11900,"KRN","B",870,870) "BLD",11900,"KRN","B",8989.51,8989.51) "BLD",11900,"KRN","B",8989.52,8989.52) "BLD",11900,"KRN","B",8993,8993) "BLD",11900,"KRN","B",8994,8994) "BLD",11900,"QDEF") ^^^^NO^^^^NO^^NO "BLD",11900,"QUES",0) ^9.62^^ "BLD",11900,"REQB",0) ^9.611^4^3 "BLD",11900,"REQB",2,0) SD*5.3*779^2 "BLD",11900,"REQB",3,0) SD*5.3*814^2 "BLD",11900,"REQB",4,0) SD*5.3*798^1 "BLD",11900,"REQB","B","SD*5.3*779",2) "BLD",11900,"REQB","B","SD*5.3*798",4) "BLD",11900,"REQB","B","SD*5.3*814",3) "INIT") EN^SD53P812 "KRN",19,3122,-1) 0^6 "KRN",19,3122,0) SD DISPLAY AVAIL REPORT^Display Clinic Availability Report^^R^^^^^^^^SCHEDULING "KRN",19,3122,1,0) ^^3^3^2920122^^ "KRN",19,3122,1,1,0) This outputs the clinic patterns for the clinics and date range requested. "KRN",19,3122,1,2,0) The patients seen in the appointment slots are listed. A legend is "KRN",19,3122,1,3,0) supplied for the appointment slot availability. "KRN",19,3122,25) SDCLAV "KRN",19,3122,99) 55130,41953 "KRN",19,3122,99.1) 64672,31385 "KRN",19,3122,"U") DISPLAY CLINIC AVAILABILITY RE "KRN",19,2922865,-1) 0^2 "KRN",19,2922865,0) SD TELE INQ^Telehealth Inquiries^^R^^^^^^^^SCHEDULING^^ "KRN",19,2922865,1,0) ^19.06^3^3 "KRN",19,2922865,1,1,0) This option allows the Scheduling Supervisor to inquire using the Clinic, "KRN",19,2922865,1,2,0) Medical Center Division, Institution, Patient, List Telehealth Stop Codes, "KRN",19,2922865,1,3,0) and Telehealth Stop Code Lookup. "KRN",19,2922865,20) "KRN",19,2922865,25) SDTMPUT0 "KRN",19,2922865,668000,0) ^19.0668^1^1 "KRN",19,2922865,668000,1,0) INQ "KRN",19,2922865,"U") TELEHEALTH INQUIRIES "KRN",19,2922866,-1) 0^8 "KRN",19,2922866,0) SD TELE TOOLS^Telehealth Management Toolbox^^M^^^^^^^^ "KRN",19,2922866,1,0) ^19.06^2^2^3220404^^^^ "KRN",19,2922866,1,1,0) This is the primary menu option which allows the user access to all "KRN",19,2922866,1,2,0) Telehealth Management options. "KRN",19,2922866,10,0) ^19.01IP^6^6 "KRN",19,2922866,10,1,0) 2922865^INQ^1 "KRN",19,2922866,10,1,"^") SD TELE INQ "KRN",19,2922866,10,2,0) 2922867^ST^2 "KRN",19,2922866,10,2,"^") SD TELE STOP CODE "KRN",19,2922866,10,3,0) 2922868^CLN^3 "KRN",19,2922866,10,3,"^") SD TELE CLN UPDATE "KRN",19,2922866,10,4,0) 2922899^PR^4 "KRN",19,2922866,10,4,"^") SD PROVIDER ADD/EDIT "KRN",19,2922866,10,5,0) 3122^DISP^99 "KRN",19,2922866,10,5,"^") SD DISPLAY AVAIL REPORT "KRN",19,2922866,10,6,0) 2922918^MSN^98 "KRN",19,2922866,10,6,"^") SD MISSING STATION NUMBER "KRN",19,2922866,40) "KRN",19,2922866,99) 66203,62958 "KRN",19,2922866,"U") TELEHEALTH MANAGEMENT TOOLBOX "KRN",19,2922867,-1) 0^3 "KRN",19,2922867,0) SD TELE STOP CODE^Telehealth Stop Code Add/Edit^^R^^SDTOOL^^^^^^ "KRN",19,2922867,1,0) ^19.06^2^2^3210831^^^^ "KRN",19,2922867,1,1,0) This option provides users with the ability to add or delete stop codes "KRN",19,2922867,1,2,0) used to identify tele health clinics. "KRN",19,2922867,25) EDIT^SDTMPEDT "KRN",19,2922867,668000,0) ^19.0668^1^1 "KRN",19,2922867,668000,1,0) ST "KRN",19,2922867,"U") TELEHEALTH STOP CODE ADD/EDIT "KRN",19,2922868,-1) 0^4 "KRN",19,2922868,0) SD TELE CLN UPDATE^VistA-Telehealth Clinic Update^^R^^SDTOOL^^^^^^ "KRN",19,2922868,1,0) ^19.06^2^2 "KRN",19,2922868,1,1,0) This option allows the Scheduling Supervisor to send clinic update "KRN",19,2922868,1,2,0) message(s) from VistA to TMP without a need to edit the Clinic Profile. "KRN",19,2922868,25) SDTMPUT1 "KRN",19,2922868,"U") VISTA-TELEHEALTH CLINIC UPDATE "KRN",19,2922899,-1) 0^5 "KRN",19,2922899,0) SD PROVIDER ADD/EDIT^Provider Add/Edit^^R^^SDTOOL^^^^^^ "KRN",19,2922899,1,0) ^^2^2^3210628^ "KRN",19,2922899,1,1,0) This option provides users with the ability to add or edit the providers "KRN",19,2922899,1,2,0) associated with a selected clinic. "KRN",19,2922899,25) PROVID^SDTMPEDT "KRN",19,2922899,"U") PROVIDER ADD/EDIT "KRN",19,2922918,-1) 0^7 "KRN",19,2922918,0) SD MISSING STATION NUMBER^Clinics Missing Station Number Report^^R^^^^^^^^SCHEDULING "KRN",19,2922918,1,0) ^19.06^1^1^3220404^^ "KRN",19,2922918,1,1,0) This report displays a report of clinics that are missing a station number. There are filters for active or inactive, and for clinic type. "KRN",19,2922918,25) BEGIN^SDTMPSTN "KRN",19,2922918,"U") CLINICS MISSING STATION NUMBER "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813^2930930 "PKG",16,22,1,"PAH",1,0) 812^3220511 "PKG",16,22,1,"PAH",1,1,0) ^^2^2^3220511 "PKG",16,22,1,"PAH",1,1,1,0) The description of this build can be found in the National Patch Module "PKG",16,22,1,"PAH",1,1,2,0) under SD*5.3*812. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 6 "RTN","SD53P812") 0^^B11469729^n/a "RTN","SD53P812",1,0) SD53P812 ;TMP/SA - POST INSTALL FOR PATCH SD*5.3*812 ;March 10, 2022 "RTN","SD53P812",2,0) ;;5.3;Scheduling;**812**;May 29, 2018;Build 17 "RTN","SD53P812",3,0) ; "RTN","SD53P812",4,0) ; load new Stop codes to the SD TELE HEALTH STOP CODE FILE #40.6. "RTN","SD53P812",5,0) ; *** post install can be rerun with no harm *** "RTN","SD53P812",6,0) ; "RTN","SD53P812",7,0) EN ; entry point "RTN","SD53P812",8,0) N ERRCNT,II,SDI,SDLIST,STP,STP1,STP2 S ERRCNT=0 "RTN","SD53P812",9,0) D MES^XPDUTL("") "RTN","SD53P812",10,0) D MES^XPDUTL("Beginning update of SD TELE HEALTH STOP CODE FILE...") "RTN","SD53P812",11,0) D MES^XPDUTL("") H 1 "RTN","SD53P812",12,0) F II=1:1 S SDLIST=$P($T(CODES+II),";;",2) Q:SDLIST="END" F SDI=1:1 S STP=$P(SDLIST,",",SDI) Q:STP="" D "RTN","SD53P812",13,0) . K DIE,FDA,SDIEN,TMPERR "RTN","SD53P812",14,0) . I $O(^SD(40.6,"B",STP,"")) D MES^XPDUTL(STP_" already on file") Q "RTN","SD53P812",15,0) . I $L(STP)=3 D Q "RTN","SD53P812",16,0) . . I '$$CHKSTOP^SDTMPEDT(STP) D MES^XPDUTL(STP_" ** Not added, invalid stop code") Q "RTN","SD53P812",17,0) . . S FDA(40.6,"+1,",.01)=STP D UPDATE^DIE("","FDA","SDIEN","TMPERR") "RTN","SD53P812",18,0) . . D:'$D(TMPERR) MES^XPDUTL(STP_" added stop code") "RTN","SD53P812",19,0) . . I $D(TMPERR) D MES^XPDUTL(STP_" failed an attempt to add to the file.") S ERRCNT=ERRCNT+1 "RTN","SD53P812",20,0) . I $L(STP)=6 D Q "RTN","SD53P812",21,0) . . S STP1=$E(STP,1,3),STP2=$E(STP,4,6) "RTN","SD53P812",22,0) . . I ('$$CHKSTOP^SDTMPEDT(STP1))!('$$CHKSTOP^SDTMPEDT(STP2)) D MES^XPDUTL(STP_" ** Not added, one or both stop codes in pair is invalid") Q "RTN","SD53P812",23,0) . . S FDA(40.6,"+1,",.01)=STP D UPDATE^DIE("","FDA","SDIEN","TMPERR") "RTN","SD53P812",24,0) . . D:'$D(TMPERR) MES^XPDUTL(STP_" added stop code pair") "RTN","SD53P812",25,0) . . I $D(TMPERR) D MES^XPDUTL(STP_" failed an attempt to add to the file.") S ERRCNT=ERRCNT+1 "RTN","SD53P812",26,0) . K DIE,FDA,SDIEN,TMPERR "RTN","SD53P812",27,0) D MES^XPDUTL("") "RTN","SD53P812",28,0) D MES^XPDUTL("Stop Code Update completed. "_ERRCNT_" error(s) found.") "RTN","SD53P812",29,0) D MES^XPDUTL("") "RTN","SD53P812",30,0) Q "RTN","SD53P812",31,0) ; "RTN","SD53P812",32,0) CODES ;Add Clinic/Telephone stop codes (only valid stop codes on file #40.7 1st) "RTN","SD53P812",33,0) ;;103,104,105,106,107,108,109,110,111,115,116,117,118,119,120,121,123,124,125,126,128,130,131,135,136,137 "RTN","SD53P812",34,0) ;;139,142,143,145,147,148,149,150,151,153,156,157,158,159,160,162,165,166,167,168,169,170,171,172,173,174 "RTN","SD53P812",35,0) ;;175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192,195,196,197,198,199,201,202,203 "RTN","SD53P812",36,0) ;;204,205,206,209,210,211,212,214,215,216,217,218,220,221,224,225,229,230,231,240,241,250,301,302,303,304 "RTN","SD53P812",37,0) ;;305,306,307,308,309,310,311,312,313,314,315,316,317,318,321,322,323,324,325,326,327,328,329,330,332,333 "RTN","SD53P812",38,0) ;;334,335,336,327,337,338,339,340,341,342,344,345,346,347,348,349,350,351,352,353,354,356,369,370,371,372,373 "RTN","SD53P812",39,0) ;;391,392,394,401,402,403,404,405,406,407,408,409,410,411,413,414,415,417,418,419,420,421,423,424,425,427 "RTN","SD53P812",40,0) ;;428,429,430,432,434,435,436,437,438,439,440,441,443,444,445,446,447,448,449,450,457,474,481,486,487,488 "RTN","SD53P812",41,0) ;;489,490,491,499,502,504,507,508,509,510,511,513,514,516,519,522,523,524,527,528,529,530,533,534,535,536 "RTN","SD53P812",42,0) ;;538,539,542,545,546,550,552,555,556,560,562,564,565,566,567,568,573,574,575,576,577,579,582,583,584,586 "RTN","SD53P812",43,0) ;;587,591,592,593,596,597,598,599,602,603,604,606,607,608,611,644,645,646,647,648,651,652,656,658,669,673 "RTN","SD53P812",44,0) ;;674,679,680,681,682,683,684,685,686,690,692,693,694,695,696,697,698,699,701,703,704,706,707,708,710,713 "RTN","SD53P812",45,0) ;;714,717,718,719,720,721,722,723,724,901,999,103801,103802,103803,323531,338531,339184,568535,674685 "RTN","SD53P812",46,0) ;;END "RTN","SDHL7CON") 0^4^B97694380^B103881672 "RTN","SDHL7CON",1,0) SDHL7CON ;MS/TG/MS/PB - TMP HL7 Routine;JULY 05, 2018 "RTN","SDHL7CON",2,0) ;;5.3;Scheduling;**704,773,812**;May 29, 2018;Build 17 "RTN","SDHL7CON",3,0) ; "RTN","SDHL7CON",4,0) ; Integration Agreements: "RTN","SDHL7CON",5,0) ; "RTN","SDHL7CON",6,0) ;SD*5.3*773 - Removed unused function TMCONV "RTN","SDHL7CON",7,0) ;SD*5.3*812 - Removed code that sent AA for "No consults found" and then quit the process "RTN","SDHL7CON",8,0) Q "RTN","SDHL7CON",9,0) ; "RTN","SDHL7CON",10,0) PARSEQ13 ;Process QBP^Q13 messages from the "TMP VISTA" Subscriber protocol "RTN","SDHL7CON",11,0) ; "RTN","SDHL7CON",12,0) ; This routine and subroutines assume that all VistA HL7 environment "RTN","SDHL7CON",13,0) ; variables are properly initialized and will produce a fatal error "RTN","SDHL7CON",14,0) ; if they are missing. "RTN","SDHL7CON",15,0) ; "RTN","SDHL7CON",16,0) ; The message will be checked to see if it is a valid query. "RTN","SDHL7CON",17,0) ; If not a negative acknowledgement will be sent. If the query is an "RTN","SDHL7CON",18,0) ; immediate mode or synchronous query, the realtime request manager "RTN","SDHL7CON",19,0) ; is called to handle the query. This means the query will be "RTN","SDHL7CON",20,0) ; processed and a response generated immediately. "RTN","SDHL7CON",21,0) ; In the future deferred mode queries may be filed in a database for "RTN","SDHL7CON",22,0) ; later processing, or transmission. "RTN","SDHL7CON",23,0) ; "RTN","SDHL7CON",24,0) ; Input: "RTN","SDHL7CON",25,0) ; HL7 environment variables "RTN","SDHL7CON",26,0) ; "RTN","SDHL7CON",27,0) ; Output: "RTN","SDHL7CON",28,0) ; Processed query or negative acknowledgement "RTN","SDHL7CON",29,0) ; If handled real-time the query response is generated "RTN","SDHL7CON",30,0) ; "RTN","SDHL7CON",31,0) ; Integration Agreements "RTN","SDHL7CON",32,0) ; "RTN","SDHL7CON",33,0) N MSGROOT,DATAROOT,QRY,XMT,ERR,RNAME,IX "RTN","SDHL7CON",34,0) S (MSGROOT,QRY,XMT,ERR,RNAME)="" "RTN","SDHL7CON",35,0) ; Inbound query messages are small enough to be held in a local. "RTN","SDHL7CON",36,0) ; The following lines commented out support use of global and are "RTN","SDHL7CON",37,0) ; left in case use a global becomes necessary. "RTN","SDHL7CON",38,0) ; "RTN","SDHL7CON",39,0) S MSGROOT="SDHL7MSG" "RTN","SDHL7CON",40,0) K @MSGROOT "RTN","SDHL7CON",41,0) N EIN "RTN","SDHL7CON",42,0) S EIN=$$FIND1^DIC(101,,,"TMP QBP-Q13 Event Driver") "RTN","SDHL7CON",43,0) ; "RTN","SDHL7CON",44,0) D LOADXMT(.HL,.XMT) ;Load inbound message information "RTN","SDHL7CON",45,0) S RNAME=XMT("MESSAGE TYPE")_"-"_XMT("EVENT TYPE")_" RECEIVER" "RTN","SDHL7CON",46,0) ; "RTN","SDHL7CON",47,0) N CNT,SEG "RTN","SDHL7CON",48,0) K @MSGROOT "RTN","SDHL7CON",49,0) D LOADMSG(MSGROOT) "RTN","SDHL7CON",50,0) ; "RTN","SDHL7CON",51,0) D PARSEMSG(MSGROOT,.HL) "RTN","SDHL7CON",52,0) ; "RTN","SDHL7CON",53,0) I '$$VALIDMSG(MSGROOT,.QRY,.XMT,.ERR) D Q "RTN","SDHL7CON",54,0) . D SENDERR(ERR) "RTN","SDHL7CON",55,0) . K @MSGROOT "RTN","SDHL7CON",56,0) . Q "RTN","SDHL7CON",57,0) ; "RTN","SDHL7CON",58,0) N CNT,RDT,HIT,EXTIME,RDF,QPD,QRYDFN,MSGCONID,LST,MYRESULT,HLA,RTCLST "RTN","SDHL7CON",59,0) ; "RTN","SDHL7CON",60,0) S (MSGCONID,QRYDFN)="" "RTN","SDHL7CON",61,0) S CNT=1 "RTN","SDHL7CON",62,0) ; "RTN","SDHL7CON",63,0) F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1 "RTN","SDHL7CON",64,0) . S SEGTYPE=$G(@MSGROOT@(CNT,0)) "RTN","SDHL7CON",65,0) . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT) S QRYDFN=$G(@MSGROOT@(CNT,3)) Q "RTN","SDHL7CON",66,0) . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q "RTN","SDHL7CON",67,0) . I SEGTYPE="MSH" S MSGCONID=$G(@MSGROOT@(CNT,9)) Q "RTN","SDHL7CON",68,0) . Q "RTN","SDHL7CON",69,0) ; "RTN","SDHL7CON",70,0) I QRYDFN="" D Q "RTN","SDHL7CON",71,0) . S ERR="QPD^1^^100^AE^No DFN value sent" "RTN","SDHL7CON",72,0) . D SENDERR(ERR) "RTN","SDHL7CON",73,0) . K @MSGROOT "RTN","SDHL7CON",74,0) . Q "RTN","SDHL7CON",75,0) ; "RTN","SDHL7CON",76,0) I '$D(^DPT(QRYDFN,0)) D Q "RTN","SDHL7CON",77,0) . S ERR="QPD^1^^100^AE^Undefined DFN" "RTN","SDHL7CON",78,0) . D SENDERR(ERR) "RTN","SDHL7CON",79,0) . K @MSGROOT "RTN","SDHL7CON",80,0) . Q "RTN","SDHL7CON",81,0) S DATAROOT=$NA(^TMP("ORQQCN",$J,"CS")) "RTN","SDHL7CON",82,0) K @DATAROOT "RTN","SDHL7CON",83,0) D LIST(.LST,QRYDFN) "RTN","SDHL7CON",84,0) D RTCLIST(.RTCLST,QRYDFN) "RTN","SDHL7CON",85,0) ; "RTN","SDHL7CON",86,0) S HIT=0,EXTIME="" "RTN","SDHL7CON",87,0) ; "RTN","SDHL7CON",88,0) ;****BUILD THE RESPONSE MSG "RTN","SDHL7CON",89,0) K @MSGROOT "RTN","SDHL7CON",90,0) ; "RTN","SDHL7CON",91,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7CON",92,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7CON",93,0) ; "RTN","SDHL7CON",94,0) N ERR,LEN S ERR="" "RTN","SDHL7CON",95,0) N FOUNDCN "RTN","SDHL7CON",96,0) S FOUNDCN=0 "RTN","SDHL7CON",97,0) S CNT=1,@MSGROOT@(CNT)=$$MSA^SDTMBUS($G(HL("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",98,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^SDTMBUS(.HL,""),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",99,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.QPD,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",100,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$BLDSEG^SDHL7UL(.RDF,.HL),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",101,0) I '$P(ERR,"^",4) D "RTN","SDHL7CON",102,0) . Q:DATAROOT="" "RTN","SDHL7CON",103,0) . D @("RDT^SDTMBUS"_"(MSGROOT,DATAROOT,.CNT,.LEN,.HL,.FOUNDCN)") "RTN","SDHL7CON",104,0) . D RTCRDT^SDTMBUS(MSGROOT,RTCLST,.CNT,.LEN,.HL) "RTN","SDHL7CON",105,0) . Q "RTN","SDHL7CON",106,0) ; "RTN","SDHL7CON",107,0) F IX=1:1:CNT S HLA("HLS",IX)=$G(@MSGROOT@(IX)) "RTN","SDHL7CON",108,0) ; "RTN","SDHL7CON",109,0) M HLA("HLA")=HLA("HLS") "RTN","SDHL7CON",110,0) ; "RTN","SDHL7CON",111,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7CON",112,0) ; "RTN","SDHL7CON",113,0) D RESET^SDHL7UL ;Clean up TMP used by logging "RTN","SDHL7CON",114,0) K @DATAROOT,@MSGROOT "RTN","SDHL7CON",115,0) ; "RTN","SDHL7CON",116,0) Q "RTN","SDHL7CON",117,0) ; "RTN","SDHL7CON",118,0) VALIDMSG(MSGROOT,QRY,XMT,ERR) ;Validate message "RTN","SDHL7CON",119,0) ; "RTN","SDHL7CON",120,0) ; Messages handled: QBP^Q13 "RTN","SDHL7CON",121,0) ; "RTN","SDHL7CON",122,0) ; QBP query messages must contain QPD and RCP segments "RTN","SDHL7CON",123,0) ; Any additional segments are ignored "RTN","SDHL7CON",124,0) ; "RTN","SDHL7CON",125,0) ; Input: "RTN","SDHL7CON",126,0) ; MSGROOT - Root of array holding message "RTN","SDHL7CON",127,0) ; XMT - Transmission parameters "RTN","SDHL7CON",128,0) ; "RTN","SDHL7CON",129,0) ; Output: "RTN","SDHL7CON",130,0) ; QRY - Query Array "RTN","SDHL7CON",131,0) ; XMT - Transmission parameters "RTN","SDHL7CON",132,0) ; ERR - segment^sequence^field^code^ACK type^error text "RTN","SDHL7CON",133,0) ; "RTN","SDHL7CON",134,0) N MSH,QPD,REQID,REQTYPE,QTAG,QNAME,RDF "RTN","SDHL7CON",135,0) N SEGTYPE,CNT "RTN","SDHL7CON",136,0) K QRY,ERR "RTN","SDHL7CON",137,0) S ERR="" "RTN","SDHL7CON",138,0) ; "RTN","SDHL7CON",139,0) ; Set up basics for responding to message. "RTN","SDHL7CON",140,0) ;----------------------------------------- "RTN","SDHL7CON",141,0) S QRY("MID")=XMT("MID") ;Message ID "RTN","SDHL7CON",142,0) S QRY("QPD")="" "RTN","SDHL7CON",143,0) ; "RTN","SDHL7CON",144,0) ; Validate message is a well-formed QBP query message. "RTN","SDHL7CON",145,0) ;----------------------------------------------------------- "RTN","SDHL7CON",146,0) ; Must have MSH first, followed by QPD,RCP in any order "RTN","SDHL7CON",147,0) ; PID and STF are optional. All other segments are ignored. "RTN","SDHL7CON",148,0) ; "RTN","SDHL7CON",149,0) I $G(@MSGROOT@(1,0))="MSH" M MSH=@MSGROOT@(1) "RTN","SDHL7CON",150,0) E S ERR="MSH^1^^100^AE^Missing MSH segment" Q 0 "RTN","SDHL7CON",151,0) ; "RTN","SDHL7CON",152,0) S CNT=2 "RTN","SDHL7CON",153,0) F Q:'$D(@MSGROOT@(CNT)) D S CNT=CNT+1 "RTN","SDHL7CON",154,0) . S SEGTYPE=$G(@MSGROOT@(CNT,0)) "RTN","SDHL7CON",155,0) . I SEGTYPE="QPD" M QPD=@MSGROOT@(CNT),QRY("QPD")=QPD Q "RTN","SDHL7CON",156,0) . I SEGTYPE="RDF" M RDF=@MSGROOT@(CNT) Q "RTN","SDHL7CON",157,0) . Q "RTN","SDHL7CON",158,0) ; "RTN","SDHL7CON",159,0) I '$D(QPD) S ERR="QPD^1^^100^AE^Missing QPD segment" Q 0 "RTN","SDHL7CON",160,0) ; "RTN","SDHL7CON",161,0) S QTAG=$G(QPD(1,1,2)) ;Query Tag "RTN","SDHL7CON",162,0) S REQID=$G(QPD(2)) ;Request ID "RTN","SDHL7CON",163,0) S REQTYPE=$G(QPD(3,1,1)) ;Request Type "RTN","SDHL7CON",164,0) S:REQTYPE="" REQTYPE=$G(QPD(3)) ;Request Type if no other params "RTN","SDHL7CON",165,0) ; "RTN","SDHL7CON",166,0) ; Validate required fields and query parameters "RTN","SDHL7CON",167,0) ;------------------------------------------------------ "RTN","SDHL7CON",168,0) ; "RTN","SDHL7CON",169,0) ; Check for missing/invalid fields "RTN","SDHL7CON",170,0) ; "RTN","SDHL7CON",171,0) I '$D(QPD(1)) S ERR="QPD^1^1^101^AE^Missing Message Query Name" Q 0 "RTN","SDHL7CON",172,0) ; "RTN","SDHL7CON",173,0) I QTAG="" S ERR="QPD^1^2^101^AE^Missing Query Tag" Q 0 "RTN","SDHL7CON",174,0) I REQID="" S ERR="QPD^1^2^101^AE^Missing Request ID" Q 0 "RTN","SDHL7CON",175,0) S (QRY("DCLSNM"),QRY("DFN"))="" "RTN","SDHL7CON",176,0) S QRY("REQID")=REQID "RTN","SDHL7CON",177,0) ; "RTN","SDHL7CON",178,0) I REQTYPE="" S ERR="QPD^1^3^101^AE^Missing Request Type" Q 0 "RTN","SDHL7CON",179,0) ; "RTN","SDHL7CON",180,0) Q 1 "RTN","SDHL7CON",181,0) ; "RTN","SDHL7CON",182,0) LOADXMT(HL,XMT) ;Set HL dependent XMT values "RTN","SDHL7CON",183,0) ; "RTN","SDHL7CON",184,0) ; The HL array and variables are expected to be defined. If not, "RTN","SDHL7CON",185,0) ; message processing will fail. These references should not be "RTN","SDHL7CON",186,0) ; wrapped in $G, as null values will simply postpone the failure to "RTN","SDHL7CON",187,0) ; a point that will be harder to diagnose. Except HL("APAT") which "RTN","SDHL7CON",188,0) ; is not defined on synchronous calls. "RTN","SDHL7CON",189,0) ; "RTN","SDHL7CON",190,0) ; Integration Agreements: "RTN","SDHL7CON",191,0) ; 1373 : Reference to PROTOCOL file #101 "RTN","SDHL7CON",192,0) ; "RTN","SDHL7CON",193,0) N SUBPROT,RESPIEN,RESP0 "RTN","SDHL7CON",194,0) S HL("EID")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Event Driver") "RTN","SDHL7CON",195,0) S HL("EIDS")=$$FIND1^DIC(101,,,"TMP QBP-Q13 Subscriber") "RTN","SDHL7CON",196,0) S XMT("MID")=HL("MID") ;Message ID "RTN","SDHL7CON",197,0) S XMT("MODE")="A" ;Response mode "RTN","SDHL7CON",198,0) I $G(HL("APAT"))="" S XMT("MODE")="S" ;Synchronous mode "RTN","SDHL7CON",199,0) S XMT("MESSAGE TYPE")=HL("MTN") ;Message type "RTN","SDHL7CON",200,0) S XMT("EVENT TYPE")=HL("ETN") ;Event type "RTN","SDHL7CON",201,0) S XMT("DELIM")=HL("FS")_HL("ECH") ;HL Delimiters "RTN","SDHL7CON",202,0) ;S XMT("DELIM")="~^\&" "RTN","SDHL7CON",203,0) S XMT("MAX SIZE")=0 ;Default size unlimited "RTN","SDHL7CON",204,0) ; "RTN","SDHL7CON",205,0) ; Map response protocol and builder "RTN","SDHL7CON",206,0) S SUBPROT=$P(^ORD(101,HL("EIDS"),0),"^") "RTN","SDHL7CON",207,0) Q "RTN","SDHL7CON",208,0) LIST(SDY,SDPT,SDSDT,SDEDT,SDSERV,SDSTATUS) ; return patient's consult requests between start date and stop date for the service and status indicated: "RTN","SDHL7CON",209,0) N I,J,SITE,SEQ,DIFF,SDSRV,ORLOC,GMRCOER "RTN","SDHL7CON",210,0) S J=1,SEQ="",GMRCOER=2 "RTN","SDHL7CON",211,0) S:'$L($G(SDSDT)) SDSDT="" "RTN","SDHL7CON",212,0) S:'$L($G(SDEDT)) SDEDT="" "RTN","SDHL7CON",213,0) S:'$L($G(SDSERV))!(+$G(SDSERV)=0) SDSERV="" "RTN","SDHL7CON",214,0) S:'$L($G(SDSTATUS)) SDSTATUS="" ;ALL STATI "RTN","SDHL7CON",215,0) K ^TMP("GMRCR",$J) "RTN","SDHL7CON",216,0) S SDY=$NA(^TMP("ORQQCN",$J,"CS")) "RTN","SDHL7CON",217,0) D OER^GMRCSLM1(SDPT,SDSERV,SDSDT,SDEDT,SDSTATUS,GMRCOER) "RTN","SDHL7CON",218,0) M @SDY=^TMP("GMRCR",$J,"CS") "RTN","SDHL7CON",219,0) K @SDY@("AD") "RTN","SDHL7CON",220,0) K @SDY@(0) "RTN","SDHL7CON",221,0) K ^TMP("GMRCR",$J) "RTN","SDHL7CON",222,0) Q "RTN","SDHL7CON",223,0) RTCLIST(SDY,SDPT,SDSDT,SDEDT) ; return patient's "Return to Clinic" appointment requests "RTN","SDHL7CON",224,0) ;SDY = return global "RTN","SDHL7CON",225,0) ;SDPT = dfn of patient "RTN","SDHL7CON",226,0) ;SDSDT = start date (based on CREATE DATE of request) "RTN","SDHL7CON",227,0) ;SDEDT = end date (based on END DATE of request) "RTN","SDHL7CON",228,0) N IDX,IEN,SDEC0,REQDT,CNT,CLINID,CID,STOP,PRVID,CMTS,MRTC,RTCINT,RTCINT,RTCPAR "RTN","SDHL7CON",229,0) S SDY=$NA(^TMP("SDHL7CON",$J,"RTCLIST")) K @SDY "RTN","SDHL7CON",230,0) S SDSDT=$G(SDSDT,"ALL"),SDEDT=$G(SDEDT),CNT=0 "RTN","SDHL7CON",231,0) Q:'$G(SDPT) ; Return nothing if no patient passed "RTN","SDHL7CON",232,0) S IDX=$NA(^SDEC(409.85,"B",SDPT)),IEN=0 "RTN","SDHL7CON",233,0) F S IEN=$O(@IDX@(IEN)) Q:'$G(IEN) D "RTN","SDHL7CON",234,0) . K RTCINT,MRTC,RTCPAR,SDEC0,CLINID,CID,PRVID,CMTS,CLINNM,STOP "RTN","SDHL7CON",235,0) . S SDEC0=$G(^SDEC(409.85,IEN,0)) "RTN","SDHL7CON",236,0) . I $P(SDEC0,U,5)'="RTC" Q "RTN","SDHL7CON",237,0) . I $P(SDEC0,U,17)'="O" Q "RTN","SDHL7CON",238,0) . S REQDT=$P(SDEC0,U,2) I SDSDT'="ALL",$P(REQDT,".",1)SDEDT) Q "RTN","SDHL7CON",239,0) . S CLINID=$P(SDEC0,U,9),CID=$P(SDEC0,U,16),PRVID=$P(SDEC0,U,13),CMTS=$P(SDEC0,U,18),CMTS=$E(CMTS,1,80) "RTN","SDHL7CON",240,0) . S:$P($G(^SDEC(409.85,IEN,3)),"^")=1 MRTC=$P($G(^SDEC(409.85,IEN,3)),"^",3),RTCINT=$P($G(^SDEC(409.85,IEN,3)),"^",2),RTCPAR=$P($G(^SDEC(409.85,IEN,3)),"^",5) "RTN","SDHL7CON",241,0) . S:$G(RTCPAR)="" RTCPAR=IEN "RTN","SDHL7CON",242,0) . S:$G(MRTC)="" MRTC=0 S:$G(RTCINT)="" RTCINT=0 "RTN","SDHL7CON",243,0) . I +CLINID D "RTN","SDHL7CON",244,0) . . S CLINNM=$$GET1^DIQ(44,CLINID_",",".01") "RTN","SDHL7CON",245,0) . . S STOP=$$GET1^DIQ(44,CLINID_",",8)_","_$$GET1^DIQ(44,CLINID_",",2503) "RTN","SDHL7CON",246,0) . S CNT=CNT+1,@SDY@(CNT)=IEN_U_REQDT_U_CLINID_U_CID_U_PRVID_U_CMTS_U_$G(MRTC)_U_$G(RTCINT)_U_$G(RTCPAR) "RTN","SDHL7CON",247,0) S @SDY=CNT "RTN","SDHL7CON",248,0) Q "RTN","SDHL7CON",249,0) PARSESEG(SEG,DATA,HL) ;Generic segment parser "RTN","SDHL7CON",250,0) ;This procedure parses a single HL7 segment and builds an array "RTN","SDHL7CON",251,0) ;subscripted by the field number containing the data for that field. "RTN","SDHL7CON",252,0) ; Does not handle segments that span nodes "RTN","SDHL7CON",253,0) ; "RTN","SDHL7CON",254,0) ; Input: "RTN","SDHL7CON",255,0) ; SEG - HL7 segment to parse "RTN","SDHL7CON",256,0) ; HL - HL7 environment array "RTN","SDHL7CON",257,0) ; "RTN","SDHL7CON",258,0) ; Output: "RTN","SDHL7CON",259,0) ; Function value - field data array [SUB1:field, SUB2:repetition, "RTN","SDHL7CON",260,0) ; SUB3:component, SUB4:sub-component] "RTN","SDHL7CON",261,0) ; "RTN","SDHL7CON",262,0) N CMP ;component subscript "RTN","SDHL7CON",263,0) N CMPVAL ;component value "RTN","SDHL7CON",264,0) N FLD ;field subscript "RTN","SDHL7CON",265,0) N FLDVAL ;field value "RTN","SDHL7CON",266,0) N REP ;repetition subscript "RTN","SDHL7CON",267,0) N REPVAL ;repetition value "RTN","SDHL7CON",268,0) N SUB ;sub-component subscript "RTN","SDHL7CON",269,0) N SUBVAL ;sub-component value "RTN","SDHL7CON",270,0) N FS ;field separator "RTN","SDHL7CON",271,0) N CS ;component separator "RTN","SDHL7CON",272,0) N RS ;repetition separator "RTN","SDHL7CON",273,0) N SS ;sub-component separator "RTN","SDHL7CON",274,0) ; "RTN","SDHL7CON",275,0) K DATA "RTN","SDHL7CON",276,0) S FS=HL("FS") "RTN","SDHL7CON",277,0) S CS=$E(HL("ECH")) "RTN","SDHL7CON",278,0) S RS=$E(HL("ECH"),2) "RTN","SDHL7CON",279,0) S SS=$E(HL("ECH"),4) "RTN","SDHL7CON",280,0) ; "RTN","SDHL7CON",281,0) S DATA(0)=$P(SEG,FS) "RTN","SDHL7CON",282,0) S SEG=$P(SEG,FS,2,9999) "RTN","SDHL7CON",283,0) ; "RTN","SDHL7CON",284,0) F FLD=1:1:$L(SEG,FS) D "RTN","SDHL7CON",285,0) . S FLDVAL=$P(SEG,FS,FLD) "RTN","SDHL7CON",286,0) . F REP=1:1:$L(FLDVAL,RS) D "RTN","SDHL7CON",287,0) . . S REPVAL=$P(FLDVAL,RS,REP) "RTN","SDHL7CON",288,0) . . I REPVAL[CS F CMP=1:1:$L(REPVAL,CS) D "RTN","SDHL7CON",289,0) . . . S CMPVAL=$P(REPVAL,CS,CMP) "RTN","SDHL7CON",290,0) . . . I CMPVAL[SS F SUB=1:1:$L(CMPVAL,SS) D "RTN","SDHL7CON",291,0) . . . . S SUBVAL=$P(CMPVAL,SS,SUB) "RTN","SDHL7CON",292,0) . . . . I SUBVAL'="" S DATA(FLD,REP,CMP,SUB)=SUBVAL "RTN","SDHL7CON",293,0) . . . I '$D(DATA(FLD,REP,CMP)),CMPVAL'="" S DATA(FLD,REP,CMP)=CMPVAL "RTN","SDHL7CON",294,0) . . I '$D(DATA(FLD,REP)),REPVAL'="",FLDVAL[RS S DATA(FLD,REP)=REPVAL "RTN","SDHL7CON",295,0) . I '$D(DATA(FLD)),FLDVAL'="" S DATA(FLD)=FLDVAL "RTN","SDHL7CON",296,0) Q "RTN","SDHL7CON",297,0) ; "RTN","SDHL7CON",298,0) LOADMSG(MSGROOT) ; Load HL7 message into temporary global for processing "RTN","SDHL7CON",299,0) ; "RTN","SDHL7CON",300,0) ;This subroutine assumes that all VistA HL7 environment variables are "RTN","SDHL7CON",301,0) ;properly initialized and will produce a fatal error if they aren't. "RTN","SDHL7CON",302,0) ; "RTN","SDHL7CON",303,0) N CNT,SEG "RTN","SDHL7CON",304,0) K @MSGROOT "RTN","SDHL7CON",305,0) F SEG=1:1 X HLNEXT Q:HLQUIT'>0 D "RTN","SDHL7CON",306,0) . S CNT=0 "RTN","SDHL7CON",307,0) . S @MSGROOT@(SEG,CNT)=HLNODE "RTN","SDHL7CON",308,0) . F S CNT=$O(HLNODE(CNT)) Q:'CNT S @MSGROOT@(SEG,CNT)=HLNODE(CNT) "RTN","SDHL7CON",309,0) Q "RTN","SDHL7CON",310,0) ; "RTN","SDHL7CON",311,0) PARSEMSG(MSGROOT,HL) ; Message Parser "RTN","SDHL7CON",312,0) ; Does not handle segments that span nodes "RTN","SDHL7CON",313,0) ; Does not handle extremely long segments (uses a local) "RTN","SDHL7CON",314,0) ; Does not handle long fields (segment parser doesn't) "RTN","SDHL7CON",315,0) ; "RTN","SDHL7CON",316,0) N SEG,CNT,DATA,MSG "RTN","SDHL7CON",317,0) F CNT=1:1 Q:'$D(@MSGROOT@(CNT)) M SEG=@MSGROOT@(CNT) D "RTN","SDHL7CON",318,0) . D PARSESEG(SEG(0),.DATA,.HL) "RTN","SDHL7CON",319,0) . K @MSGROOT@(CNT) "RTN","SDHL7CON",320,0) . I DATA(0)'="" M @MSGROOT@(CNT)=DATA "RTN","SDHL7CON",321,0) . Q:'$D(SEG(1)) "RTN","SDHL7CON",322,0) . ; "RTN","SDHL7CON",323,0) . Q "RTN","SDHL7CON",324,0) Q "RTN","SDHL7CON",325,0) SENDERR(ERR) ; Send for unsuccessful response "RTN","SDHL7CON",326,0) K @MSGROOT "RTN","SDHL7CON",327,0) D INIT^HLFNC2(EIN,.HL) "RTN","SDHL7CON",328,0) S HL("FS")="|",HL("ECH")="^~\&" "RTN","SDHL7CON",329,0) S CNT=1,@MSGROOT@(CNT)=$$MSA^SDTMBUS($G(HL("MID")),ERR,.HL),LEN=$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",330,0) S CNT=CNT+1,@MSGROOT@(CNT)=$$QAK^SDTMBUS(.HL,ERR),LEN=LEN+$L(@MSGROOT@(CNT)) "RTN","SDHL7CON",331,0) F IX=1:1:CNT S HLA("HLS",IX)=$G(@MSGROOT@(IX)) "RTN","SDHL7CON",332,0) M HLA("HLA")=HLA("HLS") "RTN","SDHL7CON",333,0) D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.MYRESULT) "RTN","SDHL7CON",334,0) Q "RTN","SDTMPHLA") 0^5^B112717895^B112653383 "RTN","SDTMPHLA",1,0) SDTMPHLA ;MS/PB - TMP HL7 Routine;May 29, 2018 "RTN","SDTMPHLA",2,0) ;;5.3;Scheduling;**704,733,773,780,798,812**;SEP 26, 2018;Build 17 "RTN","SDTMPHLA",3,0) Q "RTN","SDTMPHLA",4,0) ; "RTN","SDTMPHLA",5,0) EN(DFN,APTTM) ; Entry to the routine to build an HL7 message "RTN","SDTMPHLA",6,0) ;notification to TMP about a new appointment in a TeleHealth Clinic "RTN","SDTMPHLA",7,0) ; "RTN","SDTMPHLA",8,0) Q:$G(DFN)="" "RTN","SDTMPHLA",9,0) Q:$G(APTTM)="" "RTN","SDTMPHLA",10,0) N PARMS,SEG,WHOTO,SNODE,ANODE,CNODE,CLINODE,ERROR,MSG,ANODE1 "RTN","SDTMPHLA",11,0) S (SSTOP,PSTOP,STOP)=0 "RTN","SDTMPHLA",12,0) K CLINID "RTN","SDTMPHLA",13,0) S RTN=0,CAN=0 "RTN","SDTMPHLA",14,0) ;Q:'$D(^DPT(DFN,"S",APTTM,0)) "RTN","SDTMPHLA",15,0) S ANODE=$G(^DPT(DFN,"S",APTTM,0)) "RTN","SDTMPHLA",16,0) S ANODE1=$G(^DPT(DFN,"S",APTTM,1)) "RTN","SDTMPHLA",17,0) ;If this appointment was made by the TMP application, stop 773 "RTN","SDTMPHLA",18,0) I $G(MSH(9)),$D(^XTMP("SDTMP",+MSH(9))) Q "RTN","SDTMPHLA",19,0) S CLINID=$P(ANODE,U,1) "RTN","SDTMPHLA",20,0) S CLINODE=$G(^SC(CLINID,0)) "RTN","SDTMPHLA",21,0) S XX=0 F S XX=$O(^SC(CLINID,"S",APTTM,1,XX)) Q:XX'>0 D ;Get the correct appointment node for the patient "RTN","SDTMPHLA",22,0) .I $P(^SC(CLINID,"S",APTTM,1,XX,0),"^")=DFN S SNODE=$G(^SC(CLINID,"S",APTTM,1,XX,0)),CNODE=$P($G(^SC(CLINID,"S",APTTM,1,XX,"CONS")),"^") "RTN","SDTMPHLA",23,0) ;Q:$G(SNODE)="" ; If the appointment is not in the Hospital Location File stop. "RTN","SDTMPHLA",24,0) ;S PSTOP=$P(SNODE,"^",7),SSTOP=$P(SNODE,"^",18) "RTN","SDTMPHLA",25,0) S PSTOP=$P(CLINODE,"^",7),SSTOP=$P(CLINODE,"^",18) "RTN","SDTMPHLA",26,0) ;If both stop codes are null, stop the check, we know it is not a tele health clinic "RTN","SDTMPHLA",27,0) Q:($G(PSTOP)="")&(($G(SSTOP))="") "RTN","SDTMPHLA",28,0) S STOP=$$CHKCLIN(PSTOP) ;if STOP=0, primary stop code is not a tele health stop code so check secondary stop code to see if it is a tele health clinic "RTN","SDTMPHLA",29,0) ;I $G(STOP)=0,($$CHKCLIN(SSTOP)=0) Q ;if primary stop code is not tele health check secondary stop code if secondary not tele health stop "RTN","SDTMPHLA",30,0) I $G(STOP)=0 Q:$G(SSTOP)'>0 S STOP=$$CHKCLIN(SSTOP) ; if primary stop code is not tele health check secondary stop code if secondary not tele health stop ;773 "RTN","SDTMPHLA",31,0) Q:$G(STOP)=0 ; Double check for either primary or secondary stop code to be a tele health clinic "RTN","SDTMPHLA",32,0) I $P($G(ANODE),"^",2)["C" S CAN=1 "RTN","SDTMPHLA",33,0) S SNODE=$G(^SC(CLINID,"S",APTTM,1,1,0)) "RTN","SDTMPHLA",34,0) S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E") "RTN","SDTMPHLA",35,0) S:CAN=0 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S12" "RTN","SDTMPHLA",36,0) S:CAN=1 PARMS("MESSAGE TYPE")="SIU",PARMS("EVENT")="S15" "RTN","SDTMPHLA",37,0) I '$$NEWMSG^HLOAPI(.PARMS,.MSG,.ERROR) Q 0 "RTN","SDTMPHLA",38,0) S SEQ=1 "RTN","SDTMPHLA",39,0) D:CAN=0 SCH(DFN,SEQ,.SEG,$G(ANODE),$G(SNODE)) "RTN","SDTMPHLA",40,0) I (CAN=0&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR))) Q 0 "RTN","SDTMPHLA",41,0) D:CAN=1 SCHCAN(DFN,SEQ,.SEG,$G(ANODE),$G(SNODE),$G(CNODE)) "RTN","SDTMPHLA",42,0) I (CAN=1&('$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR))) Q 0 "RTN","SDTMPHLA",43,0) D NTE(.SEQ,.SEG) "RTN","SDTMPHLA",44,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",45,0) D PID(DFN,SEQ,.SEG) "RTN","SDTMPHLA",46,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",47,0) D PV1(DFN,SEQ,.SEG) "RTN","SDTMPHLA",48,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",49,0) D RGS1("A",SEQ,.SEG) ;required segment "RTN","SDTMPHLA",50,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",51,0) D AIL1(ANODE,SEQ,.SEG) "RTN","SDTMPHLA",52,0) I '$$ADDSEG^HLOAPI(.MSG,.SEG,.ERROR) Q 0 "RTN","SDTMPHLA",53,0) S PARMS("SENDING APPLICATION")="TMP_OUT" "RTN","SDTMPHLA",54,0) S PARMS("APP ACK TYPE")="AL" "RTN","SDTMPHLA",55,0) S WHOTO("RECEIVING APPLICATION")="TMP VIMT" "RTN","SDTMPHLA",56,0) S WHOTO("FACILITY LINK NAME")="TMP_SEND" "RTN","SDTMPHLA",57,0) S WHOTO("FACILITY LINK IEN")=$O(^HLCS(870,"B","TMP_SEND",0)) "RTN","SDTMPHLA",58,0) S RTN=$$SENDONE^HLOAPI1(.MSG,.PARMS,.WHOTO,.ERROR) "RTN","SDTMPHLA",59,0) K CAN,APTSTATUS,SSTOP,PSTOP,STOP,CLINID,PROVID,PROVNM,XX "RTN","SDTMPHLA",60,0) Q RTN "RTN","SDTMPHLA",61,0) PID(DFN,SEQ,SEG) ; "RTN","SDTMPHLA",62,0) N VA,VADM,VAHOW,VAROOT,VATEST,VAPA,NAME,DOB,SSN,ICN,ADDRESS "RTN","SDTMPHLA",63,0) K SEG S SEG="" "RTN","SDTMPHLA",64,0) S VAHOW=1 "RTN","SDTMPHLA",65,0) D DEM^VADPT "RTN","SDTMPHLA",66,0) S NAME=VADM("NM") D STDNAME^XLFNAME(.NAME,"C") "RTN","SDTMPHLA",67,0) S DOB=$P(VADM("DB"),"^"),SSN=$P(VADM("SS"),"^") "RTN","SDTMPHLA",68,0) S VAHOW="" "RTN","SDTMPHLA",69,0) D ADD^VADPT "RTN","SDTMPHLA",70,0) S ADDRESS("STREET")=VAPA(1),ADDRESS("STREET2")=VAPA(2),ADDRESS("CITY")=VAPA(4),ADDRESS("STATE")=$P(VAPA(5),"^",2),ADDRESS("ZIP")=VAPA(6) "RTN","SDTMPHLA",71,0) S ICN=$$GETICN^MPIF001(DFN) "RTN","SDTMPHLA",72,0) D SET^HLOAPI(.SEG,"PID",0) ; Set segment type to PID "RTN","SDTMPHLA",73,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set PID-1 "RTN","SDTMPHLA",74,0) ; set ICN into PID-3, repitition 1 "RTN","SDTMPHLA",75,0) D SET^HLOAPI(.SEG,+ICN,3,1,1,1) ; Component 1, subcomponent 1, Patient ICN "RTN","SDTMPHLA",76,0) D SET^HLOAPI(.SEG,$P(ICN,"V",2),3,2,1,1) ; Component 1, subcomponent 2, Patient ICN checksum "RTN","SDTMPHLA",77,0) D SET^HLOAPI(.SEG,DFN,4,1,1,1) ; patient DFN "RTN","SDTMPHLA",78,0) D SET^HLOAPI(.SEG,"USVHA",3,4,1,1) ; component 4, subcomponent1 "RTN","SDTMPHLA",79,0) D SET^HLOAPI(.SEG,"0363",3,5,1,1) ; component 5 "RTN","SDTMPHLA",80,0) ; set SSN into PID-3, repetition 2 "RTN","SDTMPHLA",81,0) D SET^HLOAPI(.SEG,SSN,3,1,1,2) ;component 1, subcomponent1 "RTN","SDTMPHLA",82,0) D SET^HLOAPI(.SEG,"USSSA",3,4,1,2) ; Component 4, subcomponent 1 "RTN","SDTMPHLA",83,0) D SET^HLOAPI(.SEG,"0363",3,4,3,2) ; component 4, subcomponent 3 "RTN","SDTMPHLA",84,0) D SET^HLOAPI(.SEG,"SS",3,5,1,2) ; component 1 "RTN","SDTMPHLA",85,0) ;Set the name inot PID-5 "RTN","SDTMPHLA",86,0) D SETXPN^HLOAPI4(.SEG,.NAME,5) "RTN","SDTMPHLA",87,0) ; Set the DOB into PID-7 "RTN","SDTMPHLA",88,0) D SETDT^HLOAPI4(.SEG,DOB,7) "RTN","SDTMPHLA",89,0) ; set the address into PID-11 "RTN","SDTMPHLA",90,0) D SETAD^HLOAPI4(.SEG,.ADDRESS,11) "RTN","SDTMPHLA",91,0) Q "RTN","SDTMPHLA",92,0) PD1 ; Not needed right now "RTN","SDTMPHLA",93,0) Q "RTN","SDTMPHLA",94,0) PV1(DFN,SEQ,SEG) ; "RTN","SDTMPHLA",95,0) N FAC "RTN","SDTMPHLA",96,0) S CLASS="OUTPATIENT" "RTN","SDTMPHLA",97,0) S FAC=$$KSP^XUPARAM("INST") "RTN","SDTMPHLA",98,0) D SET^HLOAPI(.SEG,"PV1",0) ; Set the segment type "RTN","SDTMPHLA",99,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set the PV1-1 "RTN","SDTMPHLA",100,0) ; set the PV1-2, patient class (tbl 5-20 in the TMP HL7 specification "RTN","SDTMPHLA",101,0) D SET^HLOAPI(.SEG,CLASS,2) ; "RTN","SDTMPHLA",102,0) ; set the PV1-4, Purpose of Visit "RTN","SDTMPHLA",103,0) D SET^HLOAPI(.SEG,APTSTATUS,4) "RTN","SDTMPHLA",104,0) ; set the PV1-7, provider "RTN","SDTMPHLA",105,0) D SET^HLOAPI(.SEG,$G(PROVID),7,1,1) "RTN","SDTMPHLA",106,0) D SET^HLOAPI(.SEG,$G(PROVNM),7,2,1) "RTN","SDTMPHLA",107,0) ; set the PV1-39 facility id "RTN","SDTMPHLA",108,0) D SET^HLOAPI(.SEG,FAC,39) "RTN","SDTMPHLA",109,0) K CLASS "RTN","SDTMPHLA",110,0) Q "RTN","SDTMPHLA",111,0) SCH(DFN,SEQ,SEG,ANODE,SNODE) ; update for new appointments "RTN","SDTMPHLA",112,0) N APTSTATUS,LENGTH,TMUNITS,SCHED,ENTEREDBY,STATUS,START,CONNM,PREMAIL,END "RTN","SDTMPHLA",113,0) S:$G(SNODE)'="" LENGTH=$P($G(SNODE),"^",2) "RTN","SDTMPHLA",114,0) S TMUNITS="M" "RTN","SDTMPHLA",115,0) S:$G(LENGTH)="" LENGTH=$S($G(SDECC("LEN")):$G(SDECC("LEN")),1:$P(^SC(CLINID,"SL"),U)) "RTN","SDTMPHLA",116,0) S START=$$TMCONV(APTTM,$$INST(CLINID)),END=$$FMADD^XLFDT(APTTM,0,0,LENGTH,0),END=$$TMCONV(END,$$INST(CLINID)) "RTN","SDTMPHLA",117,0) S:$G(CNODE)>0 CONNM=$P(^GMR(123.5,$P(^GMR(123,CNODE,0),"^",5),0),"^") "RTN","SDTMPHLA",118,0) S PROVID=$P(^SC(CLINID,0),"^",13) S:$G(PROVID)>0 PROVNM=$P(^VA(200,PROVID,0),"^"),PREMAIL=$P($G(^VA(200,PROVID,.15)),"^") "RTN","SDTMPHLA",119,0) K XS S (STATUS("ID"))=$S($P(ANODE,"^",2)="":"S",1:$P(ANODE,"^",2)) S:STATUS("ID")="S" STATUS("TEXT")="SCHEDULED" "RTN","SDTMPHLA",120,0) N X,X1 S STATUS("TEXT")=$$STATUS(STATUS("ID")) "RTN","SDTMPHLA",121,0) S STATUS("SYSTEM")=2 "RTN","SDTMPHLA",122,0) S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E") "RTN","SDTMPHLA",123,0) S:$G(SNODE)'="" ENTEREDBY=$P(^VA(200,$P(SNODE,"^",6),0),"^"),SCHEMAIL=$P($G(^VA(200,$P(SNODE,"^",6),.15)),"^",1) "RTN","SDTMPHLA",124,0) S:$G(SNODE)="" ENTEREDBY=$P(^VA(200,$G(DUZ),0),"^"),SCHEMAIL=$P($G(^VA(200,$G(DUZ),.15)),"^",1) "RTN","SDTMPHLA",125,0) D SET^HLOAPI(.SEG,"SCH",0) ; Set the segment type "RTN","SDTMPHLA",126,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set the SCH-1 "RTN","SDTMPHLA",127,0) D SET^HLOAPI(.SEG,APTSTATUS,6) ;Field 6, Appointment status "RTN","SDTMPHLA",128,0) D:$G(CNODE)>0 SET^HLOAPI(.SEG,CNODE,7,1) ;Consult ID if this is for a consult request "RTN","SDTMPHLA",129,0) ;D:$G(CONNM)'="" SET^HLOAPI(.SEG,CONNM,7,2) ;Consult name "RTN","SDTMPHLA",130,0) D SET^HLOAPI(.SEG,LENGTH,9) ;Field 9, Apt Length "RTN","SDTMPHLA",131,0) D SET^HLOAPI(.SEG,TMUNITS,10) ; Field 10, time units "RTN","SDTMPHLA",132,0) D SET^HLOAPI(.SEG,START,11,4,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",133,0) D SET^HLOAPI(.SEG,END,11,5,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",134,0) D SET^HLOAPI(.SEG,$G(PROVID),16,1,1) ; Field 16 provider duz "RTN","SDTMPHLA",135,0) D SET^HLOAPI(.SEG,$G(PROVNM),16,2,1) ; Field 16 provider name "RTN","SDTMPHLA",136,0) D SET^HLOAPI(.SEG,$G(PREMAIL),17,4,1) ; Field 17 provider eMail "RTN","SDTMPHLA",137,0) D SET^HLOAPI(.SEG,$G(ENTEREDBY),20,2,1) ; Field 20, scheduling clerk's the appointment "RTN","SDTMPHLA",138,0) D SET^HLOAPI(.SEG,$G(SCHEMAIL),21,4,1) ;Field 21, scheduling clerk's email "RTN","SDTMPHLA",139,0) D SETCE^HLOAPI4(.SEG,.STATUS,25) ; Field 25, current status of the appointment "RTN","SDTMPHLA",140,0) Q "RTN","SDTMPHLA",141,0) SCHCAN(DFN,SEQ,SEG,ANODE,SNODE,CNODE) ; update for cancelled appointments "RTN","SDTMPHLA",142,0) N APTSTATUS,LENGTH,TMUNITS,SCHED,ENTEREDBY,STATUS,START,PREMAIL,END "RTN","SDTMPHLA",143,0) Q:$G(SNODE)="" ;SNODE=SNODE=$G(^SC(CLINID,"S",APTTM,1,XX,0)) "RTN","SDTMPHLA",144,0) S:$G(DUZ)="" DUZ=.5 "RTN","SDTMPHLA",145,0) S:$G(DUZ(2))="" DUZ=$$KSP^XUPARAM("SITE") "RTN","SDTMPHLA",146,0) S LENGTH=$P(^SC(CLINID,"SL"),"^",1),TMUNITS="M" "RTN","SDTMPHLA",147,0) S START=$$TMCONV(APTTM,$$INST(CLINID)),END=$$FMADD^XLFDT(APTTM,0,0,LENGTH,0),END=$$TMCONV(END,$$INST(CLINID)) "RTN","SDTMPHLA",148,0) S:$G(CNODE)>0 CONNM=$$GET1^DIQ(123,CNODE_",",1,"E") ;CONNM=$P(GMR(123.5,$P(^GMR(123,CNODE,0),"^",5),0),"^") "RTN","SDTMPHLA",149,0) S PROVID=$P(^SC(CLINID,0),"^",13) S:$G(PROVID)>0 PROVNM=$P(^VA(200,PROVID,0),"^"),PREMAIL=$P($G(^VA(200,PROVID,.15)),"^") "RTN","SDTMPHLA",150,0) K XS S (STATUS("ID"),XS)=$S($P(ANODE,"^",2)="":"S",1:$P(ANODE,"^",2)) S:STATUS("ID")="S" STATUS("TEXT")="SCHEDULED" "RTN","SDTMPHLA",151,0) N X,X1 S STATUS("TEXT")=$$STATUS(STATUS("ID")) "RTN","SDTMPHLA",152,0) S STATUS("SYSTEM")=2 "RTN","SDTMPHLA",153,0) S APTSTATUS=$$GET1^DIQ(2.98,APTTM_","_DFN_",",9.5,"E") "RTN","SDTMPHLA",154,0) S ENTEREDBY=$P(^VA(200,$P(SNODE,"^",6),0),"^"),SCHEMAIL=$P($G(^VA(200,$P(SNODE,"^",6),.15)),"^",1) "RTN","SDTMPHLA",155,0) D SET^HLOAPI(.SEG,"SCH",0) ; Set the segment type "RTN","SDTMPHLA",156,0) D SET^HLOAPI(.SEG,SEQ,1) ; Set the SCH-1 "RTN","SDTMPHLA",157,0) D SET^HLOAPI(.SEG,APTSTATUS,6) ;Field 6, Appointment status "RTN","SDTMPHLA",158,0) D:$G(CNODE)>0 SET^HLOAPI(.SEG,CNODE,7,1) ;Consult ID if this is for a consult request "RTN","SDTMPHLA",159,0) ;D:$G(CONNM)'="" SET^HLOAPI(.SEG,CONNM,7,2) ;Consult name "RTN","SDTMPHLA",160,0) D SET^HLOAPI(.SEG,LENGTH,9) ;Field 9, Apt Length "RTN","SDTMPHLA",161,0) D SET^HLOAPI(.SEG,TMUNITS,10) ; Field 10, time units "RTN","SDTMPHLA",162,0) D SET^HLOAPI(.SEG,START,11,4,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",163,0) D SET^HLOAPI(.SEG,END,11,5,1,1) ; Field 11, appointment start and end time "RTN","SDTMPHLA",164,0) D SET^HLOAPI(.SEG,$G(PROVID),16,1,1) ; Field 16 provider duz "RTN","SDTMPHLA",165,0) D SET^HLOAPI(.SEG,$G(PROVNM),16,2,1) ; Field 16 provider name "RTN","SDTMPHLA",166,0) D SET^HLOAPI(.SEG,$G(PREMAIL),17,4,1) ; Field 17 provider eMail "RTN","SDTMPHLA",167,0) D SET^HLOAPI(.SEG,$G(ENTEREDBY),20,2,1) ; Field 20, scheduling clerk's the appointment "RTN","SDTMPHLA",168,0) D SET^HLOAPI(.SEG,$G(SCHEMAIL),21,4,1) ;Field 21, scheduling clerk's email "RTN","SDTMPHLA",169,0) D SETCE^HLOAPI4(.SEG,.STATUS,25) ; Field 25, current status of the appointment "RTN","SDTMPHLA",170,0) K SCHEMAIL "RTN","SDTMPHLA",171,0) Q "RTN","SDTMPHLA",172,0) PV2 ; Not needed right now "RTN","SDTMPHLA",173,0) Q "RTN","SDTMPHLA",174,0) OBX1 ; Not needed right now "RTN","SDTMPHLA",175,0) Q "RTN","SDTMPHLA",176,0) OBX2 ; Not needed right now "RTN","SDTMPHLA",177,0) Q "RTN","SDTMPHLA",178,0) OBX3 ; Not needed right now "RTN","SDTMPHLA",179,0) Q "RTN","SDTMPHLA",180,0) OBX4 ; Not needed right now "RTN","SDTMPHLA",181,0) Q "RTN","SDTMPHLA",182,0) RGS1(FLAG,SEQ,SEG) ; At least one RGS segment is required "RTN","SDTMPHLA",183,0) N GRP "RTN","SDTMPHLA",184,0) S GRP="" "RTN","SDTMPHLA",185,0) D SET^HLOAPI(.SEG,"RGS",0) "RTN","SDTMPHLA",186,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLA",187,0) D SET^HLOAPI(.SEG,FLAG,2) "RTN","SDTMPHLA",188,0) D SET^HLOAPI(.SEG,GRP,3) "RTN","SDTMPHLA",189,0) Q "RTN","SDTMPHLA",190,0) AIS1 ; "RTN","SDTMPHLA",191,0) Q "RTN","SDTMPHLA",192,0) NTE(SEQ,SEG) ; "RTN","SDTMPHLA",193,0) N NOTES,CLINID,CLINNM "RTN","SDTMPHLA",194,0) S NOTES="THESE ARE BOOKING NOTES",CLINID=23,CLINNM="GENERAL MEDICINE" "RTN","SDTMPHLA",195,0) D SET^HLOAPI(.SEG,"NTE",0) "RTN","SDTMPHLA",196,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLA",197,0) D SET^HLOAPI(.SEG,"NOTES",3) "RTN","SDTMPHLA",198,0) D SET^HLOAPI(.SEG,NOTES,4) "RTN","SDTMPHLA",199,0) Q "RTN","SDTMPHLA",200,0) AIL1(ANODE,SEQ,SEG) ; "RTN","SDTMPHLA",201,0) K LOC "RTN","SDTMPHLA",202,0) S LOC("ID")=$P(ANODE,"^",1),LOC("TEXT")=$P(^SC(LOC("ID"),0),"^"),LOC("SYSTEM")="44",CODE="A" "RTN","SDTMPHLA",203,0) S LOC("ALTERNATE ID")=$$STATION(CLINID) ;780 "RTN","SDTMPHLA",204,0) D SET^HLOAPI(.SEG,"AIL",0) "RTN","SDTMPHLA",205,0) D SET^HLOAPI(.SEG,SEQ,1) "RTN","SDTMPHLA",206,0) D SET^HLOAPI(.SEG,CODE,2) "RTN","SDTMPHLA",207,0) D SETCE^HLOAPI4(.SEG,.LOC,4) "RTN","SDTMPHLA",208,0) K LOC,CODE "RTN","SDTMPHLA",209,0) Q "RTN","SDTMPHLA",210,0) TMCONV(X,INST) ;Uses division/institution to determine tz instead of mailman files / 773 "RTN","SDTMPHLA",211,0) ;convert FileMan local time to Zulu timezone in JSON format: YYYY-MM-DDTHH:MM:00.000Z "RTN","SDTMPHLA",212,0) ;Inputs: "RTN","SDTMPHLA",213,0) ; X = Time "RTN","SDTMPHLA",214,0) ; INST = Institution "RTN","SDTMPHLA",215,0) ;Output: "RTN","SDTMPHLA",216,0) ; Zulu Time in JSON format "RTN","SDTMPHLA",217,0) N OFFSET,UTC,UTC1,UTC2 "RTN","SDTMPHLA",218,0) I X#1=0 S X=X+.000001 ;Add 1 second if midnight to avoid midnight problem in DIUTC. The second is not included in UTC2 "RTN","SDTMPHLA",219,0) S OFFSET=$P($$UTC^DIUTC(X,,$G(INST),,1),"^",3) "RTN","SDTMPHLA",220,0) S UTC=$$FMADD^XLFDT(X,,-$G(OFFSET),,),UTC1=$$FMTHL7^XLFDT(UTC) "RTN","SDTMPHLA",221,0) S UTC2=$E(UTC1,1,4)_"-"_$E(UTC1,5,6)_"-"_$E(UTC1,7,8)_"T"_$E(UTC1,9,10)_":"_$E(UTC1,11,12)_":00.000Z" "RTN","SDTMPHLA",222,0) Q UTC2 "RTN","SDTMPHLA",223,0) CHKCLIN(X) ; check to see if this is a primary or secondary stop code for a tele health clinic "RTN","SDTMPHLA",224,0) I $G(X)'>0 S STOP=0 Q STOP "RTN","SDTMPHLA",225,0) S STOP=0 "RTN","SDTMPHLA",226,0) N TEST,I,CODE,X1,X2 "RTN","SDTMPHLA",227,0) S X2=0 "RTN","SDTMPHLA",228,0) S X1=$$GET1^DIQ(40.7,X_",",1,"I"),X2=$O(^SD(40.6,"B",X1,"")) "RTN","SDTMPHLA",229,0) S:$G(X2)>0 STOP=1 "RTN","SDTMPHLA",230,0) Q STOP "RTN","SDTMPHLA",231,0) STATUS(X) ; a $Select to convert code to text too many characters in a single line. returns the text version of the appointment code "RTN","SDTMPHLA",232,0) S X1="" "RTN","SDTMPHLA",233,0) Q:$G(X)="" "RTN","SDTMPHLA",234,0) S:X="N" X1="NO-SHOW" "RTN","SDTMPHLA",235,0) S:X="C" X1="CANCELLED BY CLINIC" "RTN","SDTMPHLA",236,0) S:X="NA" X1="NO&AUTO RE-BOOK" "RTN","SDTMPHLA",237,0) S:X="CA" X1="CANCELLED BY CLINIC & AUTO RE-BOOK" "RTN","SDTMPHLA",238,0) S:X="I" X1="INPATIENT APPOINTMENT" "RTN","SDTMPHLA",239,0) S:X="PC" X1="CANCELLED BY PATIENT" "RTN","SDTMPHLA",240,0) S:X="PCA" X1="CANCELLED BY PATIENT & AUTO-REBOOK" "RTN","SDTMPHLA",241,0) S:X="NT" X1="NO ACTION TAKEN" "RTN","SDTMPHLA",242,0) S:X="S" X1="SCHEDULED" "RTN","SDTMPHLA",243,0) Q X1 "RTN","SDTMPHLA",244,0) ; "RTN","SDTMPHLA",245,0) INST(CLNC) ;Derives the institution value for the clinic "RTN","SDTMPHLA",246,0) ;Inputs: "RTN","SDTMPHLA",247,0) ; CLNC = Clinic IEN from the Hospital Location (#44) file "RTN","SDTMPHLA",248,0) ;Output: "RTN","SDTMPHLA",249,0) ; INST = Institution IEN from the Institution (#4) file. Null indicates an error. "RTN","SDTMPHLA",250,0) I CLNC="" Q "" "RTN","SDTMPHLA",251,0) N DIV,INST,MCD0,NEWINST,TZ "RTN","SDTMPHLA",252,0) S MCD0=$G(^SC(CLNC,0)) "RTN","SDTMPHLA",253,0) I MCD0="" Q "" ;No entry in the Hospital Location (#44) file "RTN","SDTMPHLA",254,0) S INST=$P(MCD0,U,4) "RTN","SDTMPHLA",255,0) I INST S TZ=$P($G(^DIC(4,INST,8)),U,1) I TZ Q INST "RTN","SDTMPHLA",256,0) S DIV=$P(MCD0,U,15) I 'DIV Q "" "RTN","SDTMPHLA",257,0) S INST=$P($G(^DG(40.8,DIV,0)),U,7) "RTN","SDTMPHLA",258,0) S NEWINST=$$CHKINST(INST) "RTN","SDTMPHLA",259,0) Q NEWINST "RTN","SDTMPHLA",260,0) ; "RTN","SDTMPHLA",261,0) CHKINST(INST) ;Derives the parent institution if the passed-in institution does not have a time zone "RTN","SDTMPHLA",262,0) I 'INST Q "" "RTN","SDTMPHLA",263,0) N TZ,AS "RTN","SDTMPHLA",264,0) S TZ=$P($G(^DIC(4,INST,8)),U,1) I TZ Q INST "RTN","SDTMPHLA",265,0) S AS=$O(^DIC(4,INST,7,"B",2,"")) I AS S INST=$P(^DIC(4,INST,7,AS,0),U,2) "RTN","SDTMPHLA",266,0) I INST S TZ=$P($G(^DIC(4,INST,8)),U,1) "RTN","SDTMPHLA",267,0) I TZ Q INST "RTN","SDTMPHLA",268,0) Q "" ;Never found an institution with a timezone "RTN","SDTMPHLA",269,0) ; "RTN","SDTMPHLA",270,0) STATION(CLNC) ;Derives the station number from the clinic - 780 "RTN","SDTMPHLA",271,0) ;Inputs: "RTN","SDTMPHLA",272,0) ; CLNC = Clinic IEN from the Hospital Location (#44) file "RTN","SDTMPHLA",273,0) ;Output: "RTN","SDTMPHLA",274,0) ; STATN = Station number from the Institution (#4) file. Null indicates an error. "RTN","SDTMPHLA",275,0) I CLNC="" Q "" "RTN","SDTMPHLA",276,0) N INST,MCD,MCD0,STATN,Z "RTN","SDTMPHLA",277,0) S MCD0=$G(^SC(CLNC,0)) I MCD0="" Q "" ;No entry in the Hospital Location (#44) file "RTN","SDTMPHLA",278,0) S INST=$P(MCD0,U,4) I INST]"" S STATN=$P($G(^DIC(4,INST,99)),U,1) I STATN Q STATN ;quit if found Stn# "RTN","SDTMPHLA",279,0) S MCD=$P(MCD0,U,15) I MCD]"" S Z=$G(^DG(40.8,MCD,0)) S STATN=$P(Z,U,2) I STATN Q STATN ;quit if found Stn# "RTN","SDTMPHLA",280,0) Q "" ;Could not locate station number "RTN","SDTMPSTN") 0^2^B15359096^n/a "RTN","SDTMPSTN",1,0) SDTMPSTN ;TMP/DRF - TMP Missing Station Report;Mar 15, 2022 "RTN","SDTMPSTN",2,0) ;;5.3;Scheduling;**812**;SEP 26, 2018;Build 17 "RTN","SDTMPSTN",3,0) Q "RTN","SDTMPSTN",4,0) ; "RTN","SDTMPSTN",5,0) BEGIN ;Report Begin & Title "RTN","SDTMPSTN",6,0) W #,"CLINICS THAT ARE MISSING STATION NUMBER",!! "RTN","SDTMPSTN",7,0) D ACT I Y="^" Q "RTN","SDTMPSTN",8,0) D ASKTYPE I Y="^" Q "RTN","SDTMPSTN",9,0) ; "RTN","SDTMPSTN",10,0) IO ;Ask IO device and Queue "RTN","SDTMPSTN",11,0) S %ZIS="PQM" D ^%ZIS I POP D END Q "RTN","SDTMPSTN",12,0) I $D(IO("Q")) D QUE,END Q "RTN","SDTMPSTN",13,0) ; "RTN","SDTMPSTN",14,0) LOOP ;Begin Report "RTN","SDTMPSTN",15,0) S FND=0,PGNO=0 "RTN","SDTMPSTN",16,0) S CL=0 F S CL=$O(^SC(CL)) Q:'CL D "RTN","SDTMPSTN",17,0) . S I=$G(^SC(CL,"I")) "RTN","SDTMPSTN",18,0) . I $P(I,U,1)>0,+$P(I,U,2)=0,ACT="A" Q ;Eliminate inactive clinics "RTN","SDTMPSTN",19,0) . I +$P(I,U,1)=0,ACT="I" Q ;Eliminate active clinics "RTN","SDTMPSTN",20,0) . S CL0=$G(^SC(CL,0)) "RTN","SDTMPSTN",21,0) . S PSTOP=$P(CL0,"^",7),SSTOP=$P(CL0,"^",18),CLTYP=$P(CL0,"^",3),NCNT=$P(CL0,"^",17) "RTN","SDTMPSTN",22,0) . I ASKTYPE'="A",CLTYP'=ASKTYPE Q ;Not the requested clinic type "RTN","SDTMPSTN",23,0) . S STN=$$STATION^SDTMPHLA(CL) "RTN","SDTMPSTN",24,0) . I STN="" D LINE "RTN","SDTMPSTN",25,0) I 'FND W "NO CLINICS MISSING STATION NUMBER WERE FOUND",! "RTN","SDTMPSTN",26,0) D END "RTN","SDTMPSTN",27,0) Q "RTN","SDTMPSTN",28,0) ; "RTN","SDTMPSTN",29,0) TYPE(CLTYP) ;Clinic Type "RTN","SDTMPSTN",30,0) I CLTYP="C" Q "CLINIC" "RTN","SDTMPSTN",31,0) I CLTYP="M" Q "MODULE" "RTN","SDTMPSTN",32,0) I CLTYP="W" Q "WARD" "RTN","SDTMPSTN",33,0) I CLTYP="Z" Q "OTHER LOCATION" "RTN","SDTMPSTN",34,0) I CLTYP="N" Q "NON-CLINIC STOP" "RTN","SDTMPSTN",35,0) I CLTYP="F" Q "FILE AREA" "RTN","SDTMPSTN",36,0) I CLTYP="I" Q "IMAGING" "RTN","SDTMPSTN",37,0) I CLTYP="OR" Q "OPERATING ROOM" "RTN","SDTMPSTN",38,0) Q "" "RTN","SDTMPSTN",39,0) ; "RTN","SDTMPSTN",40,0) HEADER ; "RTN","SDTMPSTN",41,0) W # "RTN","SDTMPSTN",42,0) S PGNO=PGNO+1 "RTN","SDTMPSTN",43,0) W ?2,"CLINICS THAT ARE MISSING STATION NUMBER",?71,"DATE: ",$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),?122,"PAGE: ",PGNO,! "RTN","SDTMPSTN",44,0) W ?2,"CLINIC TYPE: ",$S(ASKTYPE="A":"ALL",1:$$TYPE(ASKTYPE)),! "RTN","SDTMPSTN",45,0) W ?2,$S(ACT="B":"BOTH ACTIVE AND INACTIVE CLINICS",ACT="I":"INACTIVE CLINICS",1:"ACTIVE CLINICS"),! "RTN","SDTMPSTN",46,0) W ?2,"CLINIC",?10,"CLINIC NAME",?42,"ABR",?54,"TYPE",?71,"INST",?79,"DIV",?96,"PRI SC",?103,"SEC SC",?111,"NCNT",?116,"STATION",! "RTN","SDTMPSTN",47,0) W ?2,"-------",?10,"-------------------------------",?42,"-----------",?54,"----------------",?71,"-------",?79,"----------------",?96,"------",?103,"------",?111,"----",?116,"-------",! "RTN","SDTMPSTN",48,0) Q "RTN","SDTMPSTN",49,0) ; "RTN","SDTMPSTN",50,0) LINE ;Write a single clinic record "RTN","SDTMPSTN",51,0) S FND=FND+1 "RTN","SDTMPSTN",52,0) I FND#60=1 D HEADER "RTN","SDTMPSTN",53,0) N CLNM,CLABR,CLTYP,CLINS,CLDIV "RTN","SDTMPSTN",54,0) S CLNM=$P(CL0,U,1),CLABR=$P(CL0,U,2),CLTYP=$P(CL0,U,3),CLINS=$P(CL0,U,4),CLDIV=$P(CL0,U,15) "RTN","SDTMPSTN",55,0) I CLTYP]"" S CLTYP=$$TYPE(CLTYP) "RTN","SDTMPSTN",56,0) S DIV="" I CLDIV S DIV=$$GET1^DIQ(40.8,CLDIV_",",.01,"I") "RTN","SDTMPSTN",57,0) W ?2,CL,?10,CLNM,?42,CLABR,?54,CLTYP,?71,CLINS,?79,DIV,?96,PSTOP,?103,SSTOP,?111,NCNT,?116,STN,! "RTN","SDTMPSTN",58,0) Q "RTN","SDTMPSTN",59,0) ; "RTN","SDTMPSTN",60,0) QUE ;Run job in background "RTN","SDTMPSTN",61,0) S ZTRTN="LOOP^SDTMPSTN",ZTDESC="TMP CLINICS THAT ARE MISSING STATION NUMBER" "RTN","SDTMPSTN",62,0) D ^%ZTLOAD W:$D(ZTSK) !,"Task #",ZTSK," Started." "RTN","SDTMPSTN",63,0) D HOME^%ZIS K IO("Q"),ZTSK,ZTDESC,ZTQUEUED,ZTRTN "RTN","SDTMPSTN",64,0) D END "RTN","SDTMPSTN",65,0) Q "RTN","SDTMPSTN",66,0) ; "RTN","SDTMPSTN",67,0) END ;Clean up and Quit "RTN","SDTMPSTN",68,0) D:'$D(ZTQUEUED) ^%ZISC "RTN","SDTMPSTN",69,0) K ACT,ASKTYPE,DIR,DIV,CL,CL0,FND,I,NCNT,PGNO,PSTOP,SSTOP,STN,STOP1,STOP2,CLABR,CLDIV,CLINS,CLNM,CLTYP,POP,Y,ZTDESC,ZTQUEUE,ZTRTN,ZTSK "RTN","SDTMPSTN",70,0) Q "RTN","SDTMPSTN",71,0) ; "RTN","SDTMPSTN",72,0) ACT ;View active, inactive or both clinics "RTN","SDTMPSTN",73,0) S DIR(0)="SA^A:ACTIVE;I:INACTIVE;B:BOTH^",DIR("B")="B" "RTN","SDTMPSTN",74,0) S DIR("A")="List which clinics - (A)ctive, (I)nactive or (B)oth ? " "RTN","SDTMPSTN",75,0) D ^DIR "RTN","SDTMPSTN",76,0) S ACT=Y "RTN","SDTMPSTN",77,0) Q "RTN","SDTMPSTN",78,0) ; "RTN","SDTMPSTN",79,0) ASKTYPE ;Ask clinic type "RTN","SDTMPSTN",80,0) S DIR(0)="SA^C:CLINIC;M:MODULE;W:WARD;Z:OTHER LOCATION;N:NON-CLINIC STOP;F:FILE AREA;I:IMAGING;R:OPERATING ROOM;A:ALL^",DIR("B")="C" "RTN","SDTMPSTN",81,0) S DIR("A")="List which clinic types - (C)linic, (M)odule, (W)ard, (Z)Other Location, (N)on-Clinic Stop, (F)ile Area, (I)maging, Operating (R)oom or (A)ll ? " "RTN","SDTMPSTN",82,0) D ^DIR "RTN","SDTMPSTN",83,0) I Y="R" S Y="OR" "RTN","SDTMPSTN",84,0) S ASKTYPE=Y "RTN","SDTMPSTN",85,0) Q "RTN","SDTMPUT0") 0^1^B69402969^B47518599 "RTN","SDTMPUT0",1,0) SDTMPUT0 ;MS/SJA - TELEHEALTH SEARCH UTILITY ;Dec 17, 2020 "RTN","SDTMPUT0",2,0) ;;5.3;Scheduling;**773,779,812**;Aug 13, 1993;Build 17 "RTN","SDTMPUT0",3,0) ; "RTN","SDTMPUT0",4,0) ; "RTN","SDTMPUT0",5,0) N II,ARR,CNT,CODE,DFN,FAC,F407,S407,ICNHA,SIEN,MPI,NODE1,NODE8,NODE99,FICN,SDCL,NODE0,DIV,MCD,INST,INSF "RTN","SDTMPUT0",6,0) N LTZ,SDASH,CTRY,TZEX,SDSL,SDRE,SDIN,SDNO,STP1,STP2,OPT,VADM,XX,ZD "RTN","SDTMPUT0",7,0) S $P(SDASH,"=",80)="" "RTN","SDTMPUT0",8,0) EN W @IOF W ?22,"Telehealth Inquiries",!! "RTN","SDTMPUT0",9,0) K DIRUT,DUOUT,DIR "RTN","SDTMPUT0",10,0) S DIR(0)="SA^C:Clinic;M:Medical Center Division;I:Institution;P:Patient Information;L:List Stop codes;S:Stop Code Lookup;SN:Station Number (Time Sensitive);Q:QUIT" "RTN","SDTMPUT0",11,0) S DIR("A",1)=" Select one of the following:" "RTN","SDTMPUT0",12,0) S DIR("A",2)="" "RTN","SDTMPUT0",13,0) S DIR("A",3)=" C Clinic" "RTN","SDTMPUT0",14,0) S DIR("A",4)=" M Medical Center Division" "RTN","SDTMPUT0",15,0) S DIR("A",5)=" I Institution" "RTN","SDTMPUT0",16,0) S DIR("A",6)=" P Patient Information" "RTN","SDTMPUT0",17,0) S DIR("A",7)=" L List Telehealth Stop Codes" "RTN","SDTMPUT0",18,0) S DIR("A",8)=" S Telehealth Stop Code Lookup" "RTN","SDTMPUT0",19,0) S DIR("A",9)=" SN Station Number (Time Sensitive)" "RTN","SDTMPUT0",20,0) S DIR("A",10)="" "RTN","SDTMPUT0",21,0) S DIR("A")="Search Option or (Q)uit: " "RTN","SDTMPUT0",22,0) D ^DIR K DIR I Y="Q"!$D(DTOUT)!$D(DIRUT) G END "RTN","SDTMPUT0",23,0) S OPT=Y W ! "RTN","SDTMPUT0",24,0) D @OPT "RTN","SDTMPUT0",25,0) G EN "RTN","SDTMPUT0",26,0) ; "RTN","SDTMPUT0",27,0) C ; Search by clinic "RTN","SDTMPUT0",28,0) K DIC,SDCL,SDNO,NOD0,PNODE,DIV,SDSL,MCD,INST,INSF,LTZ,CTRY,TZEX "RTN","SDTMPUT0",29,0) S DIC="^SC(",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))" "RTN","SDTMPUT0",30,0) S DIC("A")="Select CLINIC: " D ^DIC K DIC("S"),DIC("A") Q:"^"[X I +Y'>0 G:+Y<0 C "RTN","SDTMPUT0",31,0) S SDCL=Y "RTN","SDTMPUT0",32,0) S SDNO="",NODE0=$G(^SC(+SDCL,0)),DIV=$P(NODE0,U,15) "RTN","SDTMPUT0",33,0) S SDSL=$G(^SC(+SDCL,"SL")),MCD=$G(^DG(40.8,DIV,0)),INST=$P(MCD,U,7) "RTN","SDTMPUT0",34,0) S INSF=$G(^DIC(4,INST,8)),LTZ=$P(INSF,U),CTRY=$P(INSF,U,2),TZEX=$P(INSF,U,3) "RTN","SDTMPUT0",35,0) W !!,SDASH,! "RTN","SDTMPUT0",36,0) W !,"Clinic",?18,": ",$TR(SDCL,"^","-") "RTN","SDTMPUT0",37,0) W !,"Default Provider",?18,": " I $P(NODE0,U,13) W $P(NODE0,U,13),"-",$P(^VA(200,$P(NODE0,U,13),0),U) "RTN","SDTMPUT0",38,0) W !,"Provider",?18,": " "RTN","SDTMPUT0",39,0) S II=0 F S II=$O(^SC(+SDCL,"PR",II)) Q:'II D "RTN","SDTMPUT0",40,0) . I $D(^SC(+SDCL,"PR",II,0)) S PNODE=^SC(+SDCL,"PR",II,0) W ?20,+PNODE,"-",$P(^VA(200,+PNODE,0),U),?50,$S($P(PNODE,U,2):" << Default >>",1:""),! "RTN","SDTMPUT0",41,0) W:'$O(^SC(+SDCL,"PR",0)) ! W "Medical Division",?18,": ",DIV,"-",$$GET1^DIQ(40.8,DIV,.01) "RTN","SDTMPUT0",42,0) W !,"Institution",?18,": ",INST,"-",$$GET1^DIQ(4,INST,.01) "RTN","SDTMPUT0",43,0) W !,"Station Number",?18,": ",$$GET1^DIQ(4,INST_",",99,"E") "RTN","SDTMPUT0",44,0) W !,"Stop Code",?18,": ",$P(NODE0,U,7),"-",$$GET1^DIQ(40.7,$P(NODE0,U,7),.01)," (",$$GET1^DIQ(40.7,$P(NODE0,U,7),1),")" "RTN","SDTMPUT0",45,0) W !,"Credit Stop Code",?18,": ",$P(NODE0,U,18),"-",$$GET1^DIQ(40.7,$P(NODE0,U,18),.01)," (",$$GET1^DIQ(40.7,$P(NODE0,U,18),1),")" "RTN","SDTMPUT0",46,0) W !,"Country",?18,": ",CTRY,"-",$$GET1^DIQ(779.004,CTRY,.01) "RTN","SDTMPUT0",47,0) W !,"Location Timezone",?18,": ",LTZ,"-",$$GET1^DIQ(1.71,LTZ,.01) "RTN","SDTMPUT0",48,0) W !,"Timezone Exception",?18,": ",TZEX "RTN","SDTMPUT0",49,0) W !,"Overbooks per day",?18,": ",$P(SDSL,U,7) "RTN","SDTMPUT0",50,0) D ACT "RTN","SDTMPUT0",51,0) W !,SDASH,!! G C "RTN","SDTMPUT0",52,0) Q "RTN","SDTMPUT0",53,0) ; "RTN","SDTMPUT0",54,0) M ; Search by Medical Center Division "RTN","SDTMPUT0",55,0) K DIC,ZD,MCD,INST,INSF,LTZ,CTRY,TZEX "RTN","SDTMPUT0",56,0) S DIC="^DG(40.8,",DIC(0)="AEMQ" D ^DIC K DIC "RTN","SDTMPUT0",57,0) Q:"^"[X I +Y'>0 W !,$C(7),"Division not found. Please try again." G M "RTN","SDTMPUT0",58,0) S ZD=+Y "RTN","SDTMPUT0",59,0) S MCD=$G(^DG(40.8,ZD,0)),INST=$P(MCD,U,7) "RTN","SDTMPUT0",60,0) S INSF=$G(^DIC(4,INST,8)),LTZ=$P(INSF,U),CTRY=$P(INSF,U,2),TZEX=$P(INSF,U,3) "RTN","SDTMPUT0",61,0) W !!,SDASH,! "RTN","SDTMPUT0",62,0) W !,"Medical Division",?18,": ",ZD,"-",$$GET1^DIQ(40.8,ZD,.01) "RTN","SDTMPUT0",63,0) W !,"Facility Number",?18,": ",$P(MCD,U,2) "RTN","SDTMPUT0",64,0) W !,"Institution",?18,": ",INST,"-",$$GET1^DIQ(4,INST,.01) "RTN","SDTMPUT0",65,0) W !,SDASH,!! G M "RTN","SDTMPUT0",66,0) Q "RTN","SDTMPUT0",67,0) ; "RTN","SDTMPUT0",68,0) I ; search by Institution "RTN","SDTMPUT0",69,0) K DIC,FAC,NOD0,NODE1,NODE8,II,ARR,LTZ,CTRY,TZEX,NODE99 "RTN","SDTMPUT0",70,0) S DIC="^DIC(4,",DIC(0)="AEMNQ" D ^DIC K DIC Q:Y<1 0 "RTN","SDTMPUT0",71,0) Q:"^"[X I +Y'>0 W !,$C(7),"Institution not found. Please try again." G I "RTN","SDTMPUT0",72,0) S FAC=Y "RTN","SDTMPUT0",73,0) S NODE0=$G(^DIC(4,+Y,0)),NODE1=$G(^DIC(4,+Y,1)) "RTN","SDTMPUT0",74,0) S NODE8=$G(^DIC(4,+Y,8)),LTZ=$P(NODE8,U),CTRY=$P(NODE8,U,2),TZEX=$P(NODE8,U,3) "RTN","SDTMPUT0",75,0) S NODE99=$G(^DIC(4,+Y,99)) "RTN","SDTMPUT0",76,0) W !!,SDASH,! "RTN","SDTMPUT0",77,0) W !,"Name",?18,": ",$TR(FAC,"^","-") "RTN","SDTMPUT0",78,0) W !,"City",?18,": ",$P(NODE1,U,3) "RTN","SDTMPUT0",79,0) W !,"State",?18,": ",$P(NODE0,U,2),"-",$$GET1^DIQ(5,$P(NODE0,U,2),.01) "RTN","SDTMPUT0",80,0) W !,"District",?18,": ",$P(NODE0,U,3) "RTN","SDTMPUT0",81,0) W !,"VA region IEN",?18,": ",$P(NODE0,U,7) "RTN","SDTMPUT0",82,0) W !,"Location Timezone",?18,": ",LTZ,"-",$$GET1^DIQ(1.71,LTZ,.01) "RTN","SDTMPUT0",83,0) W !,"Timezone Exception",?18,": ",TZEX "RTN","SDTMPUT0",84,0) W !,"Country",?18,": ",CTRY,"-",$$GET1^DIQ(779.004,CTRY,.01) "RTN","SDTMPUT0",85,0) W !,"Station #",?18,": ",$P(NODE99,U) "RTN","SDTMPUT0",86,0) W !,"Facility DEA #:",?18,": ",$P($G(^DIC(4,+FAC,"DEA")),U) "RTN","SDTMPUT0",87,0) W !,"Facility Exp. date",?18,": ",$P($G(^DIC(4,+FAC,"DEA")),U,2) "RTN","SDTMPUT0",88,0) S II=0 F S II=$O(^DIC(4,+FAC,7,II)) Q:'II K ARR D GETS^DIQ(4.014,II_","_+FAC,".01;1","E","ARR") D "RTN","SDTMPUT0",89,0) . W !,"Association",?18,": ",II_"-"_ARR(4.014,II_","_+FAC_",",.01,"E") "RTN","SDTMPUT0",90,0) . W ?40," Parent",": ",II_"-"_ARR(4.014,II_","_+FAC_",",1,"E") "RTN","SDTMPUT0",91,0) W !,SDASH,!! G I "RTN","SDTMPUT0",92,0) Q "RTN","SDTMPUT0",93,0) ; "RTN","SDTMPUT0",94,0) P ; search by patient "RTN","SDTMPUT0",95,0) K DIC,DFN,MPI,XX,ICNHA,VADM "RTN","SDTMPUT0",96,0) S DIC="^DPT(",DIC(0)="AEMQ",DIC("A")="Select Patient: " D ^DIC K DIC "RTN","SDTMPUT0",97,0) Q:"^"[X I +Y'>0 W !,$C(7),"Patient not found. Please try again." G P "RTN","SDTMPUT0",98,0) S DFN=+Y D 2^VADPT S MPI=$G(^DPT(DFN,"MPI")) "RTN","SDTMPUT0",99,0) W !,SDASH "RTN","SDTMPUT0",100,0) W !,"Number (IEN)",?18,": ",DFN "RTN","SDTMPUT0",101,0) W !,"Name",?18,": ",VADM(1) "RTN","SDTMPUT0",102,0) W !,"Sex",?18,": ",$P(VADM(5),U,2) "RTN","SDTMPUT0",103,0) W !,"Date of Birth",?18,": ",$P(VADM(3),U,2) "RTN","SDTMPUT0",104,0) W !,"SSN",?18,": ",$P(VADM(2),U,2) "RTN","SDTMPUT0",105,0) W !,"Full ICN",?18,": ",$P(MPI,U,10) "RTN","SDTMPUT0",106,0) W !,"Integrated Control: ",$P(MPI,U) "RTN","SDTMPUT0",107,0) W !,"ICN Checksum",?18,": ",$P(MPI,U,2) "RTN","SDTMPUT0",108,0) D ICN W !,"Full ICN History :" S XX=0 F S XX=$O(ICNHA(XX)) Q:'XX W ?20,$G(ICNHA(XX)),! "RTN","SDTMPUT0",109,0) W "Deceased Date",?18,": ",$P($P(VADM(6),U,2),"@"),! "RTN","SDTMPUT0",110,0) D SC "RTN","SDTMPUT0",111,0) W !,SDASH G P "RTN","SDTMPUT0",112,0) Q "RTN","SDTMPUT0",113,0) ; "RTN","SDTMPUT0",114,0) S ; Telehealth stop code "RTN","SDTMPUT0",115,0) K DIC,CODE,STP1,STP2,F407,S407 "RTN","SDTMPUT0",116,0) S DIC="^SD(40.6,",DIC(0)="AEMNQ" D ^DIC K DIC "RTN","SDTMPUT0",117,0) Q:"^"[X I +Y'>0 W !,$C(7),"Telehealth Stop Code not found. Please try again." G S "RTN","SDTMPUT0",118,0) S CODE=$P(Y,U,2),STP1=$E(CODE,1,3),STP2=$E(CODE,4,6) "RTN","SDTMPUT0",119,0) S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0)) "RTN","SDTMPUT0",120,0) W !!,SDASH,! "RTN","SDTMPUT0",121,0) W !,"Stop Code: ",STP1," > ",$P($G(^DIC(40.7,F407,0)),U) "RTN","SDTMPUT0",122,0) I $G(STP2) W !,"Stop Code: ",STP2," > ",$P($G(^DIC(40.7,S407,0)),U) "RTN","SDTMPUT0",123,0) W !,SDASH,!! K X,Y G S "RTN","SDTMPUT0",124,0) Q "RTN","SDTMPUT0",125,0) ; "RTN","SDTMPUT0",126,0) L ; list Telehealth stop codes "RTN","SDTMPUT0",127,0) K DIC,CNT,II,STP1,STP2,F407,S407 "RTN","SDTMPUT0",128,0) S CNT=0 W !!,SDASH,! "RTN","SDTMPUT0",129,0) S II=0 F S II=$O(^SD(40.6,"B",II)) Q:'II D "RTN","SDTMPUT0",130,0) . S CNT=CNT+1,STP1=$E(II,1,3),STP2=$E(II,4,6) "RTN","SDTMPUT0",131,0) . S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0)) "RTN","SDTMPUT0",132,0) . I STP2 W !,"Stop Code: ",STP1_STP2 D Q "RTN","SDTMPUT0",133,0) . . W !,?11,STP1," > ",$P($G(^DIC(40.7,F407,0)),U) "RTN","SDTMPUT0",134,0) . . W !,?11,STP2," > ",$P($G(^DIC(40.7,S407,0)),U) "RTN","SDTMPUT0",135,0) . W !,"Stop Code: ",STP1," > ",$P($G(^DIC(40.7,F407,0)),U) "RTN","SDTMPUT0",136,0) W !,SDASH "RTN","SDTMPUT0",137,0) W !,"Total number of Telehealth Stop code: ",CNT,!! "RTN","SDTMPUT0",138,0) S DIR(0)="EA",DIR("A")="Press to continue" D ^DIR K DIR "RTN","SDTMPUT0",139,0) Q "RTN","SDTMPUT0",140,0) ; "RTN","SDTMPUT0",141,0) SN ; Search by Station Number "RTN","SDTMPUT0",142,0) K DIC,NODE0,II K ^TMP($J) "RTN","SDTMPUT0",143,0) N1 S DIC="^VA(389.9,",DIC(0)="AEMQ" D ^DIC K DIC I Y>0 S ^TMP($J,+Y)="",DIC("A")="Another one:" G N1 "RTN","SDTMPUT0",144,0) I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,0))) Q "RTN","SDTMPUT0",145,0) W !!,SDASH "RTN","SDTMPUT0",146,0) F II=0:0 S II=$O(^TMP($J,II)) Q:'II W ! D "RTN","SDTMPUT0",147,0) . S NODE0=$G(^VA(389.9,II,0)) "RTN","SDTMPUT0",148,0) . W !,"Number: ",II,?35,"Reference Number: ",$P(NODE0,U) "RTN","SDTMPUT0",149,0) . W !,?2,"Effective Date: " I $P(NODE0,U,2) W $$FMTE^XLFDT($P(NODE0,U,2),1) "RTN","SDTMPUT0",150,0) . W ?35,"Medical Center Division: " I $P(NODE0,U,3) W $P(NODE0,U,3)_"-",$$GET1^DIQ(40.8,$P(NODE0,U,3),.01) "RTN","SDTMPUT0",151,0) . W !,?2,"Station Number: ",$P(NODE0,U,4),?35,"Inactive: ",$S($P(NODE0,U,6):"Yes",1:"No") "RTN","SDTMPUT0",152,0) . W !,?2,"Is Primary Division: ",$S($P(NODE0,U,5):"Yes",1:"No") "RTN","SDTMPUT0",153,0) . W ! "RTN","SDTMPUT0",154,0) K ^TMP($J) "RTN","SDTMPUT0",155,0) W !!,SDASH,! G SN "RTN","SDTMPUT0",156,0) Q "RTN","SDTMPUT0",157,0) ; "RTN","SDTMPUT0",158,0) ICN ; full ICN history "RTN","SDTMPUT0",159,0) K ICNHA "RTN","SDTMPUT0",160,0) I '$D(^DPT(DFN,"MPIFICNHIS")) S ICNHA(1)="NO ICN HISTORY" Q "RTN","SDTMPUT0",161,0) S (SIEN,CNT)=0 "RTN","SDTMPUT0",162,0) F S SIEN=$O(^DPT(DFN,"MPIFICNHIS",SIEN)) Q:'SIEN D "RTN","SDTMPUT0",163,0) . S FICN=$P($G(^DPT(DFN,"MPIFICNHIS",SIEN,0)),"^") I FICN'="" S CNT=CNT+1,ICNHA(CNT)=FICN "RTN","SDTMPUT0",164,0) I CNT=0 S ICNHA(1)="NO ICN HISTORY" Q "RTN","SDTMPUT0",165,0) S ICNHA=CNT "RTN","SDTMPUT0",166,0) Q "RTN","SDTMPUT0",167,0) ; "RTN","SDTMPUT0",168,0) ACT ; inactive clinic "RTN","SDTMPUT0",169,0) I $D(^SC(+SDCL,"I")) S SDRE=+$P(^("I"),U,2),SDIN=+^("I") I SDRE'=SDIN I SDIN'>DT&(SDRE=0!(SDRE>DT)) D "RTN","SDTMPUT0",170,0) . S Y=SDIN D DTS^SDUTL W !!,?4,"**** Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"")," ****" K SDIN,SDRE S SDNO=1 "RTN","SDTMPUT0",171,0) I 'SDNO,$D(SDIN),SDIN>DT,SDRE'=SDIN W !!,?4,"**** Clinic will be inactive ",$S(SDRE:"from ",1:"as of ") S Y=SDIN D DTS^SDUTL W Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"")," ****" K SDIN,SDRE "RTN","SDTMPUT0",172,0) Q "RTN","SDTMPUT0",173,0) ; "RTN","SDTMPUT0",174,0) END K ARR,CNT,CODE,CTRY,DFN,FAC,F407,S407,ICNHA,SIEN,II,MPI,NODE1,NODE8,NODE99,FICN,SDCL,NODE0,DIV,MCD,INST,INSF "RTN","SDTMPUT0",175,0) K LTZ,SDASH,STP1,STP2,TZEX,SDSL,SDRE,SDIN,SDNO,OPT,VADM,XX,ZD "RTN","SDTMPUT0",176,0) Q "RTN","SDTMPUT0",177,0) ; "RTN","SDTMPUT0",178,0) SC ;SERVICE CONNECTED MESSAGE/IOFO - BAY PINES/TEH "RTN","SDTMPUT0",179,0) N VAEL "RTN","SDTMPUT0",180,0) I +$P($G(^DPT(DFN,.3)),U,2)>49 D "RTN","SDTMPUT0",181,0) . W !,?7,"********** THIS PATIENT IS 50% OR GREATER SERVICE-CONNECTED **********",! "RTN","SDTMPUT0",182,0) D 2^VADPT "RTN","SDTMPUT0",183,0) W !,"PATIENT'S SERVICE CONNECTION AND RATED DISABILITIES:" "RTN","SDTMPUT0",184,0) I $$GET1^DIQ(2,DFN_",",.301,"E")="YES"&($P(VAEL(3),"^",2)'="") D "RTN","SDTMPUT0",185,0) . W !,"SC Percent: "_$P(VAEL(3),"^",2)_"%" "RTN","SDTMPUT0",186,0) I $$GET1^DIQ(2,DFN_",",.301,"E")="NO"&($P(VAEL(3),"^",2)="") D "RTN","SDTMPUT0",187,0) . W !,"Service Connected: No" "RTN","SDTMPUT0",188,0) ;Rated Disabilities "RTN","SDTMPUT0",189,0) N SDSER,SDRAT,SDREC,NN,NUM "RTN","SDTMPUT0",190,0) S (NN,NUM)=0 "RTN","SDTMPUT0",191,0) F S NN=$O(^DPT(DFN,.372,NN)) Q:'NN D "RTN","SDTMPUT0",192,0) . S SDREC=$G(^DPT(DFN,.372,NN,0)) I SDREC'="" D "RTN","SDTMPUT0",193,0) . . S SDRAT="" S NUM=$P($G(SDREC),"^",1) I NUM>0 S SDRAT=$$GET1^DIQ(31,NUM_",",.01) "RTN","SDTMPUT0",194,0) . . S SDSER="" S SDSER=$S($P(SDREC,"^",3)="1":"SC",1:"NSC") "RTN","SDTMPUT0",195,0) . . W !," "_SDRAT_" ("_SDSER_" - "_$P(SDREC,"^",2)_"%)" "RTN","SDTMPUT0",196,0) ; "RTN","SDTMPUT0",197,0) W !,"Primary Eligibility Code: "_$P(VAEL(1),"^",2) "RTN","SDTMPUT0",198,0) I $P($G(^DPT(DFN,.372,0)),"^",4)<1 W !,"No Service Connected Disabilities Listed" "RTN","SDTMPUT0",199,0) Q "RTN","SDUNC") 0^3^B25544291^B24539563 "RTN","SDUNC",1,0) SDUNC ;ALB/MGD - RESTORE CLINIC AVAILABILITY ;Apr 12, 2022 "RTN","SDUNC",2,0) ;;5.3;Scheduling;**79,303,380,452,780,806,814,812**;Aug 13, 1993;Build 17 "RTN","SDUNC",3,0) ;;Per VHA Directive 6402, this routine should not be modified "RTN","SDUNC",4,0) ; "RTN","SDUNC",5,0) D DT^DICRW S DIC=44,DIC(0)="MEQA",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select CLINIC NAME: " D ^DIC K DIC("S"),DIC("A") Q:"^"[X G:Y<0 SDUNC Q:'$D(^SC(+Y,"SL")) "RTN","SDUNC",6,0) S SC=+Y,SL=^("SL") ;NAKED REFERENCE - ^SC(IFN,"SL") "RTN","SDUNC",7,0) N SDRES S SDRES=$$CLNCK^SDUTL2(SC,1) "RTN","SDUNC",8,0) I 'SDRES W !,?5,"Clinic MUST be corrected before continuing." G SDUNC "RTN","SDUNC",9,0) S %DT="AEXF",%DT("A")="RESTORE '"_$P(Y,U,2)_"' FOR WHAT DATE: " D ^%DT K %DT Q:Y<0 "RTN","SDUNC",10,0) S (SD,CDATE)=Y,%=$P(SL,U,6),SI=$S(%="":4,%<3:4,%:%,1:4),%=$P(SL,U,3),STARTDAY=$S(%:%,1:8) "RTN","SDUNC",11,0) K SDIN,SDIN1,SDRE,SDRE1 I $D(^SC(SC,"I")) S SDIN=+^("I"),SDRE=+$P(^("I"),"^",2),Y=SDIN D DTS^SDUTL S SDIN1=Y,Y=SDRE D DTS^SDUTL S SDRE1=Y "RTN","SDUNC",12,0) I $S('$D(SDIN):0,'SDIN:0,SDIN>CDATE:0,SDRE'>CDATE&(SDRE):0,1:1) W !,*7,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),SDIN1,$S(SDRE:" to "_SDRE1,1:"") G SDUNC "RTN","SDUNC",13,0) K SDIN,SDIN1,SDRE,SDRE1 G:'$D(^SC(SC,"ST",SD,1)) NOWAY "RTN","SDUNC",14,0) I $D(^SC(SC,"ST",SD,1)),^(1)'["CANCELLED"&(^(1)'["X") G NOWAY "RTN","SDUNC",15,0) I $D(^SC(SC,"ST",SD,9)) I $D(^SC(SC,"OST",SD,1)) D FIX Q:"^"[$G(X) Q:^SC(SC,"ST",SD,1)["X"&('$D(SDFR1)) S ^SC(SC,"ST",SD,1)=HOLD K:^(1)'["X" ^SC(SC,"ST",SD,"CAN") W !,"RESTORED!",*7 D CHK Q "RTN","SDUNC",16,0) I $D(^SC(SC,"ST",SD,9)),'$D(^SC(SC,"OST",SD,1)) G ERRM^SDUNC1 "RTN","SDUNC",17,0) D B I '$D(DH) G NOPAT "RTN","SDUNC",18,0) Q:^SC(SC,"ST",SD,1)["X"&('$D(SDFR1)) S ^SC(SC,"ST",SD,0)=SD,^SC(SC,"ST",SD,1)=DH G N "RTN","SDUNC",19,0) NOWAY W !,*7,"CLINIC HAS NOT BEEN CANCELLED FOR THAT DATE, SO IT CANNOT BE RESTORED",*7 G SDUNC "RTN","SDUNC",20,0) NOPAT W !,*7,"NO UPCOMING OR INDEFINITE APPOINTMENT PATTERN EXISTS FOR DAY OF WEEK,",!,"CREATE 'AVAILABILITY' PATTERN THRU 'CLINIC SETUP', THEN RESTORE AGAIN",*7 G SDUNC "RTN","SDUNC",21,0) B S X=SD D DOW^SDM0 S DOW=Y,SS=$O(^SC(SC,"T"_Y,X)) I SS'="",$D(^(SS,1)),^(1)]"" S DH=$P("SU^MO^TU^WE^TH^FR^SA","^",DOW+1)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),DO=X+1,DA(1)=SC,HOLD=DH D FIX2 "RTN","SDUNC",22,0) Q "RTN","SDUNC",23,0) N I '$F(^SC(SC,"ST",SD,1),"[") K ^SC(SC,"ST",SD) W !,*7,"CLINIC DOES NOT MEET ON THAT DAY" G SDUNC "RTN","SDUNC",24,0) K:^SC(SC,"ST",SD,1)'["X" ^SC(SC,"ST",SD,"CAN") W !,"RESTORED!",*7 D:'$G(TMPP) TMPD D CHK K TMPP Q ;Added code to stop TMPD call if a partial day restore *812 "RTN","SDUNC",25,0) FIX I ^SC(SC,"ST",SD,1)["X" S SDREST=^SC(SC,"OST",SD,1) D SEL Q "RTN","SDUNC",26,0) S HOLD=^SC(SC,"OST",SD,1) "RTN","SDUNC",27,0) Q "RTN","SDUNC",28,0) CHK F N1=SD:0 S N1=$O(^SC(SC,"S",N1)) Q:'N1!(N1\1-SD) I $D(^SC(SC,"S",N1,"MES")) D KMES I $D(SDFR1),'$D(^("MES")) Q "RTN","SDUNC",29,0) Q "RTN","SDUNC",30,0) FIX2 Q:^SC(SC,"ST",SD,1)'["X" "RTN","SDUNC",31,0) S SDREST=DH D SEL Q:'$D(SDFR1) S DH=HOLD "RTN","SDUNC",32,0) Q "RTN","SDUNC",33,0) SEL K SDFR1 Q:'$D(^SC(SC,"SL")) S SL=^("SL"),%=$P(SL,U,6),SI=$S(%="":4,%<3:4,%:%,1:4),%=$P(SL,U,3),STARTDAY=$S(%:%,1:8) "RTN","SDUNC",34,0) W !,"Clinic has been cancelled for the following periods:",! "RTN","SDUNC",35,0) K SDTEMP,SDZZ S SDZZ=0 F I=SD:0 S I=$O(^SC(SC,"SDCAN",I)) Q:'I!(I\1-SD) S SDZZ=SDZZ+1,X=I D TM S SDFR=X,SDFRX=X1,X="."_$P(^(I,0),"^",2) D TM S SDTO=X,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_SDTO,SDZZ(SDZZ)=SDFRX_"-"_X1 "RTN","SDUNC",36,0) F I=SD:0 S I=$O(^SC(SC,"S",I)) Q:'I!(I\1-SD) I $D(^SC(SC,"S",I,"MES")),'$D(^SC(SC,"SDCAN",I)) S X=I D TM S SDFRX=X1,SDFR=X,X="."_$E(^SC(SC,"S",I,"MES"),17,20) D TM S SDZZ=SDZZ+1,SDTEMP(SDFRX_"-"_X1)=SDFR_"^"_X,SDZZ(SDZZ)=SDFRX_"-"_X1 "RTN","SDUNC",37,0) F I1=0:0 S I1=$O(SDZZ(I1)) Q:'I1 S I=SDTEMP(SDZZ(I1)) W !,?9,"(",$J(I1,2),") ","From: ",$J($P(I,"^",1),8)," To: ",$J($P(I,"^",2),8) "RTN","SDUNC",38,0) A K SDFRX,X1,SDFR,SDTO R !!,"RESTORE WHICH PERIOD?: ",X:DTIME Q:"^"[X "RTN","SDUNC",39,0) I X?1"?".E W !,"Enter the # that precedes the time period you want to restore." G A "RTN","SDUNC",40,0) S SDR=X I $D(SDZZ(SDR)),$D(SDTEMP(SDZZ(SDR))) W " ",$P(SDTEMP(SDZZ(SDR)),"^",1)," - ",$P(SDTEMP(SDZZ(SDR)),"^",2) G ROK "RTN","SDUNC",41,0) W !,*7,"INVALID CHOICE, TRY AGAIN" G A "RTN","SDUNC",42,0) ROK S X=$P(SDZZ(SDR),"-",1) D TC S FR=X,SDBEG=%+SI+SI,X=$P(SDZZ(SDR),"-",2) D TC S TO=X,SDEND=%+SI+SI "RTN","SDUNC",43,0) S SDFR1=CDATE+(FR/10000) K SDTEMP,SDZZ,SDR "RTN","SDUNC",44,0) S HOLD=^SC(SC,"ST",SD,1),HOLD=$E(HOLD,1,SDBEG-1)_$E(SDREST,SDBEG,SDEND)_$E(HOLD,SDEND+1,80) D TMPP K ^SC(SC,"SDCAN",SDFR1) I $D(^SC(SC,"SDCAN",0)) S CNT=$P(^(0),U,4),CNT=$S(CNT>0:CNT-1,1:0),^(0)=$P(^(0),U,1,3)_U_CNT K CNT "RTN","SDUNC",45,0) I HOLD'["[" S I5=$F(HOLD,"|"),HOLD=$E(HOLD,1,(I5-2))_"["_$E(HOLD,I5,999) K I5 "RTN","SDUNC",46,0) K SDBEG,SDEND,SDANS,SI,STARTDAY,FR,TO Q "RTN","SDUNC",47,0) KMES I '$D(SDFR1) K ^("MES") Q ;NAKED REFERENCE - ^SC(IFN,"S",DATE,"MES") "RTN","SDUNC",48,0) I $D(SDFR1),N1=SDFR1 K ^("MES") Q ;NAKED REFERENCE - ^SC(IFN,"S",DATE,"MES") "RTN","SDUNC",49,0) Q "RTN","SDUNC",50,0) TC S %=$E(X,3,4),%=X\100-STARTDAY*SI+(%*SI\60)*2 "RTN","SDUNC",51,0) Q "RTN","SDUNC",52,0) TM S X=$E($P(X,".",2)_"0000",1,4),X1=X,%=X>1159 S:X>1259 X=X-1200 S X=X\100_":"_$E(X#100+100,2,3)_" "_$E("AP",%+1)_"M" Q "RTN","SDUNC",53,0) TMPD D EN^SDTMPHLC(SC,SD,,"UC","RESTORED - DAY") Q ;780 "RTN","SDUNC",54,0) TMPP N F,T S F=+(SD_"."_FR),T=+(SD_"."_TO) D EN^SDTMPHLC(SC,F,T,"UP","RESTORED - PARTIAL DAY") S TMPP=1 Q ;780 "VER") 8.0^22.2 "BLD",11900,6) ^670 **END** **END**