Released SD*5.3*645 SEQ #537 Extracted from mail message **KIDS**:SD*5.3*645^ **INSTALL NAME** SD*5.3*645 "BLD",9598,0) SD*5.3*645^SCHEDULING^0^3160203^y "BLD",9598,1,0) ^^7^7^3160203^ "BLD",9598,1,1,0) Build for adding 'CID/PREFERRED DATE' to the title field in files #2, "BLD",9598,1,2,0) #409.3, and #409.36. It also updates input and output routines where "BLD",9598,1,3,0) 'desired date' has been shown to the user. From this patch forward, "BLD",9598,1,4,0) 'desired date' is replaced with 'CID/Preferred Date' and 'CID/PD' in "BLD",9598,1,5,0) reports where there is a space restriction. The field name "BLD",9598,1,6,0) 'DESIRED DATE OF APPOINTMENT' and the title 'CID/PREFERRED DATE' have the "BLD",9598,1,7,0) same meaning. "BLD",9598,4,0) ^9.64PA^409.36^3 "BLD",9598,4,2,0) 2 "BLD",9598,4,2,2,0) ^9.641^2.98^1 "BLD",9598,4,2,2,2.98,0) APPOINTMENT (sub-file) "BLD",9598,4,2,2,2.98,1,0) ^9.6411^27^1 "BLD",9598,4,2,2,2.98,1,27,0) DESIRED DATE OF APPOINTMENT "BLD",9598,4,2,222) y^y^p^^^^n^^n "BLD",9598,4,2,224) "BLD",9598,4,409.3,0) 409.3 "BLD",9598,4,409.3,2,0) ^9.641^409.3^1 "BLD",9598,4,409.3,2,409.3,0) SD WAIT LIST (File-top level) "BLD",9598,4,409.3,2,409.3,1,0) ^9.6411^22^1 "BLD",9598,4,409.3,2,409.3,1,22,0) DESIRED DATE OF APPOINTMENT "BLD",9598,4,409.3,222) y^y^p^^^^n^^n "BLD",9598,4,409.3,224) "BLD",9598,4,409.36,0) 409.36 "BLD",9598,4,409.36,2,0) ^9.641^409.36^1 "BLD",9598,4,409.36,2,409.36,0) SDWL TRANSFER ACCEPT (File-top level) "BLD",9598,4,409.36,2,409.36,1,0) ^9.6411^22^1 "BLD",9598,4,409.36,2,409.36,1,22,0) DESIRED DATE OF APPOINTMENT "BLD",9598,4,409.36,222) y^y^p^^^^n^^n "BLD",9598,4,409.36,224) "BLD",9598,4,"APDD",2,2.98) "BLD",9598,4,"APDD",2,2.98,27) "BLD",9598,4,"APDD",409.3,409.3) "BLD",9598,4,"APDD",409.3,409.3,22) "BLD",9598,4,"APDD",409.36,409.36) "BLD",9598,4,"APDD",409.36,409.36,22) "BLD",9598,4,"B",2,2) "BLD",9598,4,"B",409.3,409.3) "BLD",9598,4,"B",409.36,409.36) "BLD",9598,6.3) 7 "BLD",9598,"ABPKG") n "BLD",9598,"KRN",0) ^9.67PA^779.2^20 "BLD",9598,"KRN",.4,0) .4 "BLD",9598,"KRN",.4,"NM",0) ^9.68A^3^3 "BLD",9598,"KRN",.4,"NM",1,0) SDWL30DAY FILE #409.3^409.3^0 "BLD",9598,"KRN",.4,"NM",2,0) SDWLRO FILE #409.3^409.3^0 "BLD",9598,"KRN",.4,"NM",3,0) SDWLWTR FILE #409.3^409.3^0 "BLD",9598,"KRN",.4,"NM","B","SDWL30DAY FILE #409.3",1) "BLD",9598,"KRN",.4,"NM","B","SDWLRO FILE #409.3",2) "BLD",9598,"KRN",.4,"NM","B","SDWLWTR FILE #409.3",3) "BLD",9598,"KRN",.401,0) .401 "BLD",9598,"KRN",.402,0) .402 "BLD",9598,"KRN",.403,0) .403 "BLD",9598,"KRN",.5,0) .5 "BLD",9598,"KRN",.84,0) .84 "BLD",9598,"KRN",3.6,0) 3.6 "BLD",9598,"KRN",3.8,0) 3.8 "BLD",9598,"KRN",9.2,0) 9.2 "BLD",9598,"KRN",9.8,0) 9.8 "BLD",9598,"KRN",9.8,"NM",0) ^9.68A^22^20 "BLD",9598,"KRN",9.8,"NM",1,0) SCRPW77^^0^B111268055 "BLD",9598,"KRN",9.8,"NM",2,0) SCRPW78^^0^B20645395 "BLD",9598,"KRN",9.8,"NM",3,0) SDAMEP3^^0^B21041626 "BLD",9598,"KRN",9.8,"NM",4,0) SDM0^^0^B93886442 "BLD",9598,"KRN",9.8,"NM",5,0) SDM2A^^0^B21850662 "BLD",9598,"KRN",9.8,"NM",6,0) SDMM1^^0^B16255799 "BLD",9598,"KRN",9.8,"NM",7,0) SDWL120^^0^B7897103 "BLD",9598,"KRN",9.8,"NM",8,0) SDWLE110^^0^B23562010 "BLD",9598,"KRN",9.8,"NM",11,0) SDWLRPT1^^0^B45492477 "BLD",9598,"KRN",9.8,"NM",12,0) SDWLWTR^^0^B2690330 "BLD",9598,"KRN",9.8,"NM",13,0) SCRPW62^^0^B38498572 "BLD",9598,"KRN",9.8,"NM",14,0) SDWLE7^^0^B14943839 "BLD",9598,"KRN",9.8,"NM",15,0) SDWLROF^^0^B31584484 "BLD",9598,"KRN",9.8,"NM",16,0) SDWLROS^^0^B32624484 "BLD",9598,"KRN",9.8,"NM",17,0) SDWLRQ1^^0^B40571252 "BLD",9598,"KRN",9.8,"NM",18,0) SDWLI^^0^B79675388 "BLD",9598,"KRN",9.8,"NM",19,0) SDWLIFT3^^0^B62511843 "BLD",9598,"KRN",9.8,"NM",20,0) SDWLIFT6^^0^B60758561 "BLD",9598,"KRN",9.8,"NM",21,0) SDWLRPS1^^0^B41748823 "BLD",9598,"KRN",9.8,"NM",22,0) SDWLRAD^^0^B20910333 "BLD",9598,"KRN",9.8,"NM","B","SCRPW62",13) "BLD",9598,"KRN",9.8,"NM","B","SCRPW77",1) "BLD",9598,"KRN",9.8,"NM","B","SCRPW78",2) "BLD",9598,"KRN",9.8,"NM","B","SDAMEP3",3) "BLD",9598,"KRN",9.8,"NM","B","SDM0",4) "BLD",9598,"KRN",9.8,"NM","B","SDM2A",5) "BLD",9598,"KRN",9.8,"NM","B","SDMM1",6) "BLD",9598,"KRN",9.8,"NM","B","SDWL120",7) "BLD",9598,"KRN",9.8,"NM","B","SDWLE110",8) "BLD",9598,"KRN",9.8,"NM","B","SDWLE7",14) "BLD",9598,"KRN",9.8,"NM","B","SDWLI",18) "BLD",9598,"KRN",9.8,"NM","B","SDWLIFT3",19) "BLD",9598,"KRN",9.8,"NM","B","SDWLIFT6",20) "BLD",9598,"KRN",9.8,"NM","B","SDWLRAD",22) "BLD",9598,"KRN",9.8,"NM","B","SDWLROF",15) "BLD",9598,"KRN",9.8,"NM","B","SDWLROS",16) "BLD",9598,"KRN",9.8,"NM","B","SDWLRPS1",21) "BLD",9598,"KRN",9.8,"NM","B","SDWLRPT1",11) "BLD",9598,"KRN",9.8,"NM","B","SDWLRQ1",17) "BLD",9598,"KRN",9.8,"NM","B","SDWLWTR",12) "BLD",9598,"KRN",19,0) 19 "BLD",9598,"KRN",19.1,0) 19.1 "BLD",9598,"KRN",101,0) 101 "BLD",9598,"KRN",409.61,0) 409.61 "BLD",9598,"KRN",771,0) 771 "BLD",9598,"KRN",779.2,0) 779.2 "BLD",9598,"KRN",870,0) 870 "BLD",9598,"KRN",8989.51,0) 8989.51 "BLD",9598,"KRN",8989.52,0) 8989.52 "BLD",9598,"KRN",8994,0) 8994 "BLD",9598,"KRN","B",.4,.4) "BLD",9598,"KRN","B",.401,.401) "BLD",9598,"KRN","B",.402,.402) "BLD",9598,"KRN","B",.403,.403) "BLD",9598,"KRN","B",.5,.5) "BLD",9598,"KRN","B",.84,.84) "BLD",9598,"KRN","B",3.6,3.6) "BLD",9598,"KRN","B",3.8,3.8) "BLD",9598,"KRN","B",9.2,9.2) "BLD",9598,"KRN","B",9.8,9.8) "BLD",9598,"KRN","B",19,19) "BLD",9598,"KRN","B",19.1,19.1) "BLD",9598,"KRN","B",101,101) "BLD",9598,"KRN","B",409.61,409.61) "BLD",9598,"KRN","B",771,771) "BLD",9598,"KRN","B",779.2,779.2) "BLD",9598,"KRN","B",870,870) "BLD",9598,"KRN","B",8989.51,8989.51) "BLD",9598,"KRN","B",8989.52,8989.52) "BLD",9598,"KRN","B",8994,8994) "BLD",9598,"QUES",0) ^9.62^^ "BLD",9598,"REQB",0) ^9.611^13^13 "BLD",9598,"REQB",1,0) SD*5.3*291^1 "BLD",9598,"REQB",2,0) SD*5.3*241^1 "BLD",9598,"REQB",3,0) SD*5.3*622^1 "BLD",9598,"REQB",4,0) SD*5.3*611^1 "BLD",9598,"REQB",5,0) SD*5.3*446^1 "BLD",9598,"REQB",6,0) SD*5.3*394^1 "BLD",9598,"REQB",7,0) SD*5.3*419^1 "BLD",9598,"REQB",8,0) SD*5.3*554^1 "BLD",9598,"REQB",9,0) SD*5.3*491^1 "BLD",9598,"REQB",10,0) SD*5.3*414^1 "BLD",9598,"REQB",11,0) SD*5.3*448^1 "BLD",9598,"REQB",12,0) SD*5.3*263^1 "BLD",9598,"REQB",13,0) SD*5.3*412^1 "BLD",9598,"REQB","B","SD*5.3*241",2) "BLD",9598,"REQB","B","SD*5.3*263",12) "BLD",9598,"REQB","B","SD*5.3*291",1) "BLD",9598,"REQB","B","SD*5.3*394",6) "BLD",9598,"REQB","B","SD*5.3*412",13) "BLD",9598,"REQB","B","SD*5.3*414",10) "BLD",9598,"REQB","B","SD*5.3*419",7) "BLD",9598,"REQB","B","SD*5.3*446",5) "BLD",9598,"REQB","B","SD*5.3*448",11) "BLD",9598,"REQB","B","SD*5.3*491",9) "BLD",9598,"REQB","B","SD*5.3*554",8) "BLD",9598,"REQB","B","SD*5.3*611",4) "BLD",9598,"REQB","B","SD*5.3*622",3) "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^y^p^^^^n^^n "FIA",2,0,10) "FIA",2,0,11) "FIA",2,0,"RLRO") "FIA",2,0,"VR") 5.3^SD "FIA",2,2) 1 "FIA",2,2.98) 1 "FIA",2,2.98,27) "FIA",409.3) SD WAIT LIST "FIA",409.3,0) ^SDWL(409.3, "FIA",409.3,0,0) 409.3IP "FIA",409.3,0,1) y^y^p^^^^n^^n "FIA",409.3,0,10) "FIA",409.3,0,11) "FIA",409.3,0,"RLRO") "FIA",409.3,0,"VR") 5.3^SD "FIA",409.3,409.3) 1 "FIA",409.3,409.3,22) "FIA",409.36) SDWL TRANSFER ACCEPT "FIA",409.36,0) ^SDWL(409.36, "FIA",409.36,0,0) 409.36P "FIA",409.36,0,1) y^y^p^^^^n^^n "FIA",409.36,0,10) "FIA",409.36,0,11) "FIA",409.36,0,"RLRO") "FIA",409.36,0,"VR") 5.3^SD "FIA",409.36,409.36) 1 "FIA",409.36,409.36,22) "KRN",.4,1476,-1) 0^2 "KRN",.4,1476,0) SDWLRO^3151215.0958^@^409.3^^@^3160203 "KRN",.4,1476,"F",1) .01;L25;X~"REOPEN REASON: ";C42~29;X~"EWL TYPE: ";C1~4;X;L25~"CID/PREFERRED DATE: ";C42~22;X;~"APPT: ";C1~13.2;L25;C7;X~13;X;d;L20;C36~13.8;L20;C60;X~ "KRN",.4,1476,"F",2) "REOPEN COMMENTS: ";C1~30;X~"";S1~ "KRN",.4,1476,"H") EWL Reopened Entries Report "KRN",.4,1508,-1) 0^1 "KRN",.4,1508,0) SDWL30DAY^3160111.091^@^409.3^^@^3160203 "KRN",.4,1508,"DXS") 2 "KRN",.4,1508,"DXS",1,9) X DXS(1,9.81) S X=$S(DIP(2):DIP(3),DIP(4):DIP(5),DIP(102):DIP(202),DIP(302):DIP(402),DIP(403):X) S D0=I(0,0) "KRN",.4,1508,"DXS",1,9.2) S I(0,0)=$G(D0),DIP(1)=$S($D(^SDWL(409.3,D0,0)):^(0),1:"") S X=$P($G(^SCTM(404.51,+$P(DIP(1),U,6),0)),U)'="",DIP(2)=$G(X) S X=$P($G(^SCTM(404.51,+$P(DIP(1),U,6),0)),U) "KRN",.4,1508,"DXS",1,9.3) X DXS(1,9.2) S DIP(3)=$G(X) S X=$P($G(^SCTM(404.57,+$P(DIP(1),U,7),0)),U)'="",DIP(4)=$G(X) S X=$P($G(^SCTM(404.57,+$P(DIP(1),U,7),0)),U),DIP(5)=$G(X) "KRN",.4,1508,"DXS",1,9.4) X DXS(1,9.3) S DIP(6)=$G(X),D0=$P(DIP(1),U,8) S:'D0!'$D(^SDWL(409.31,+D0,0)) D0=-1 S I(100,0)=$G(D0),DIP(101)=$S($D(^SDWL(409.31,D0,0)):^(0),1:"") "KRN",.4,1508,"DXS",1,9.5) X DXS(1,9.4) S X=$P($G(^DIC(40.7,+$P(DIP(101),U,1),0)),U)'="",DIP(102)=$G(X),DIP(103)=$G(X),D0=$P(DIP(1),U,8) S:'D0!'$D(^SDWL(409.31,+D0,0)) D0=-1 S I(200,0)=$G(D0) "KRN",.4,1508,"DXS",1,9.6) X DXS(1,9.5) S DIP(201)=$S($D(^SDWL(409.31,D0,0)):^(0),1:"") S X=$P($G(^DIC(40.7,+$P(DIP(201),U,1),0)),U),DIP(202)=$G(X),DIP(203)=$G(X) "KRN",.4,1508,"DXS",1,9.7) X DXS(1,9.6) S D0=$P(DIP(1),U,9) S:'D0!'$D(^SDWL(409.32,+D0,0)) D0=-1 S I(300,0)=$G(D0),DIP(301)=$S($D(^SDWL(409.32,D0,0)):^(0),1:"") "KRN",.4,1508,"DXS",1,9.8) X DXS(1,9.7) S X=$P($G(^SC(+$P(DIP(301),U,1),0)),U)'="",DIP(302)=$G(X),DIP(303)=$G(X),D0=$P(DIP(1),U,9) S:'D0!'$D(^SDWL(409.32,+D0,0)) D0=-1 "KRN",.4,1508,"DXS",1,9.81) X DXS(1,9.8) S DIP(401)=$S($D(^SDWL(409.32,D0,0)):^(0),1:"") S X=$P($G(^SC(+$P(DIP(401),U,1),0)),U),DIP(402)=$G(X) S X=1,DIP(403)=$G(X) S X="ERROR" "KRN",.4,1508,"F",1) .01;"NAME";L20~-2,^DPT(^^S I(0,0)=D0 S DIP(1)=$S($D(^SDWL(409.3,D0,0)):^(0),1:"") S X=$P(DIP(1),U,1),X=X S D(0)=+X;Z;".01:"~ "KRN",.4,1508,"F",2) -2,S DIP(101)=$S($D(^DPT(D0,0)):^(0),1:"") S X=$P(DIP(101),U,9),DIP(102)=$G(X) S X=6,DIP(103)=$G(X) S X=9,X=$E(DIP(102),DIP(103),X) W X K DIP;"SSN";L4;Z;"$E(SOCIAL SECURITY NUMBER,6,9)"~ "KRN",.4,1508,"F",3) 22;"CID/PD"~1;"ORIG DT"~X DXS(1,9) W X K DIP;"CLINIC/SPECIALTY";L26;Z;"$S(#5'="":#5,#6'="":#6,#7'="":#7,#8'="":#8,1:"ERROR")"~ "KRN",.4,1508,"H") EWL 30 DAY REPORT "KRN",.4,1510,-1) 0^3 "KRN",.4,1510,0) SDWLWTR^3151215.1447^@^409.3^^@^3160203 "KRN",.4,1510,"DXS") 4 "KRN",.4,1510,"DXS",1,9.2) S I(0,0)=$G(D0),DIP(1)=$S($D(^SDWL(409.3,D0,0)):^(0),1:""),D0=$P(DIP(1),U,1) S:'D0!'$D(^DPT(+D0,0)) D0=-1 S DIP(102)=$S($D(^DPT(D0,0)):^(0),1:"") "KRN",.4,1510,"DXS",2,9) S DIP(2)=$S($D(^SDWL(409.3,D0,0)):^(0),1:""),DIP(1)=$S($D(^SDWL(409.3,D0,"DIS")):^("DIS"),1:"") S X=$P(DIP(1),U,1),X1=X,X2=$P(DIP(2),U,2),X="" D:X2 ^%DTC:X1 "KRN",.4,1510,"DXS",3,9) S DIP(1)=$S($D(^SDWL(409.3,D0,0)):^(0),1:""),DIP(2)=$S($D(^SDWL(409.3,D0,"SDAPT")):^("SDAPT"),1:"") S X=$P(DIP(1),U,2),X1=X,X2=$P(DIP(2),U,1),X="" D:X2 ^%DTC:X1 "KRN",.4,1510,"F",1) .01;L20~ "KRN",.4,1510,"F",2) X DXS(1,9.2) S DIP(101)=$G(X) S X=$P(DIP(102),U,9),DIP(103)=$G(X) S X=6,DIP(104)=$G(X) S X=9,X=$E(DIP(103),DIP(104),X) S D0=I(0,0) W X K DIP;"SSN";L4;Z;"PATIENT:$E(SSN,6,9)"~ "KRN",.4,1510,"F",3) 1;"ORIG DATE";L11~13;"SCHED DT APPT";C45;L11~13.1;"DT APPT MADE";L11;C65~22;"CID/PREFERRED DATE";"";L11;C80~19;"DISPOSITION DT";L14;C96~"a. ";C33~ "KRN",.4,1510,"F",4) S DIP(1)=$S($D(^SDWL(409.3,D0,0)):^(0),1:"") S X=$P(DIP(1),U,23),X1=X,X2=$P(DIP(1),U,2),X="" D:X2 ^%DTC:X1 W X K DIP;"";L10;Z;"SCHEDULED DATE OF APPT-ORIGINATING DATE"~ "KRN",.4,1510,"F",5) "b. "~ "KRN",.4,1510,"F",6) S DIP(1)=$S($D(^SDWL(409.3,D0,0)):^(0),1:"") S X=$P(DIP(1),U,16),X1=X,X2=$P(DIP(1),U,2),X="" D:X2 ^%DTC:X1 W X K DIP;"";L10;Z;"CID/PREFERRED DATE-ORIGINATING DATE"~ "KRN",.4,1510,"F",7) "c. "~ "KRN",.4,1510,"F",8) S DIP(1)=$S($D(^SDWL(409.3,D0,0)):^(0),1:"") S X=$P(DIP(1),U,16),X1=X,X2=$P(DIP(1),U,23),X="" D:X2 ^%DTC:X1 W X K DIP;"";L10;Z;"CID/PREFERRED DATE-SCHEDULED DATE OF APPT"~ "KRN",.4,1510,"F",9) "d. "~X DXS(2,9) W X K DIP;"";L10;Z;"DATE DISPOSITIONED-ORIGINATING DATE"~"e. "~X DXS(3,9) W X K DIP;"";L10;Z;"ORIGINATING DATE-DATE APPT. MADE"~ "KRN",.4,1510,"H") EWL WAIT TIME STATISTICS REPORT "MBREQ") 0 "ORD",5,.4) .4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%) "ORD",5,.4,0) PRINT TEMPLATE "PKG",48,-1) 1^1 "PKG",48,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",48,20,0) ^9.402P^^ "PKG",48,22,0) ^9.49I^1^1 "PKG",48,22,1,0) 5.3^2930813^2960613 "PKG",48,22,1,"PAH",1,0) 645^3160203 "PKG",48,22,1,"PAH",1,1,0) ^^7^7^3160203 "PKG",48,22,1,"PAH",1,1,1,0) Build for adding 'CID/PREFERRED DATE' to the title field in files #2, "PKG",48,22,1,"PAH",1,1,2,0) #409.3, and #409.36. It also updates input and output routines where "PKG",48,22,1,"PAH",1,1,3,0) 'desired date' has been shown to the user. From this patch forward, "PKG",48,22,1,"PAH",1,1,4,0) 'desired date' is replaced with 'CID/Preferred Date' and 'CID/PD' in "PKG",48,22,1,"PAH",1,1,5,0) reports where there is a space restriction. The field name "PKG",48,22,1,"PAH",1,1,6,0) 'DESIRED DATE OF APPOINTMENT' and the title 'CID/PREFERRED DATE' have the "PKG",48,22,1,"PAH",1,1,7,0) same meaning. "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") 20 "RTN","SCRPW62") 0^13^B38498572^B35851518 "RTN","SCRPW62",1,0) SCRPW62 ;BP-CIOFO/KEITH - SC veterans awaiting appointments ;1/5/16 12:26pm "RTN","SCRPW62",2,0) ;;5.3;Scheduling;**267,269,358,491,645**;AUG 13, 1993;Build 7 "RTN","SCRPW62",3,0) ; "RTN","SCRPW62",4,0) ;Prompt for report parameters "RTN","SCRPW62",5,0) ; "RTN","SCRPW62",6,0) N SDOUT,DIR,DTOUT,DUOUT,SDFMT,SDATES,SDDIV,SDRPT,SDSCVT "RTN","SCRPW62",7,0) N SDELIM,SDX,ZTSAVE,X,Y "RTN","SCRPW62",8,0) S SDOUT=0 "RTN","SCRPW62",9,0) D TITL^SCRPW50("SC Veterans Awaiting Appointments") "RTN","SCRPW62",10,0) W !,"Note: Once the scheduling replacement application has been implemented at your" "RTN","SCRPW62",11,0) W !,"site, this report will no longer be accurate." "RTN","SCRPW62",12,0) RPT D SUBT^SCRPW50("**** Report Type Selection ****") "RTN","SCRPW62",13,0) ; SD*5.3*645 - replaced 'DATE DESIRED' with 'CID/PREFERRED DATE' "RTN","SCRPW62",14,0) ;S DIR(0)="S^E:ENTERED WITH NO APPOINTMENT PROVIDED;A:APPOINTMENTS BEYOND DATE DESIRED",DIR("A")="Select report type" "RTN","SCRPW62",15,0) S DIR(0)="S^E:ENTERED WITH NO APPOINTMENT PROVIDED;A:APPOINTMENTS BEYOND CID/PREFERRED DATE",DIR("A")="Select report type" "RTN","SCRPW62",16,0) S DIR("?",1)="Specify 'E' to return SC veterans entered but not yet provided an appointment," "RTN","SCRPW62",17,0) ;S DIR("?")="'A' to return SC veterans with appointments beyond the date desired." "RTN","SCRPW62",18,0) S DIR("?")="'A' to return SC veterans with appointments beyond the CID/Preferred date." "RTN","SCRPW62",19,0) W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT "RTN","SCRPW62",20,0) K DIR S SDRPT=Y D ENT:SDRPT="E",APPT:SDRPT="A" G:SDOUT EXIT "RTN","SCRPW62",21,0) D SUBT^SCRPW50("**** Patient Eligibility Selection ****") "RTN","SCRPW62",22,0) S DIR(0)="S^1:50-100% SC Veterans;2:0-50% SC Veterans;3:All SC Veterans" "RTN","SCRPW62",23,0) S DIR("A")="Select eligibility type" "RTN","SCRPW62",24,0) S DIR("?")="Specify the eligibility of the patients you wish to include." "RTN","SCRPW62",25,0) W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT "RTN","SCRPW62",26,0) K DIR S SDSCVT=Y "RTN","SCRPW62",27,0) FMT D SUBT^SCRPW50("**** Report Format Selection ****") "RTN","SCRPW62",28,0) S DIR(0)="S^D:DETAILED REPORT;S:STATISTICS ONLY" "RTN","SCRPW62",29,0) S DIR("A")="Select report format" "RTN","SCRPW62",30,0) S DIR("?")="Specify the report format desired." "RTN","SCRPW62",31,0) W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT "RTN","SCRPW62",32,0) K DIR S SDFMT=Y "RTN","SCRPW62",33,0) I SDFMT="S" S SDELIM=0 G QUE "RTN","SCRPW62",34,0) D SUBT^SCRPW50("**** Output Format Selection ****") "RTN","SCRPW62",35,0) S DIR(0)="Y",DIR("A")="Return report output in delimited format" "RTN","SCRPW62",36,0) S DIR("B")="NO" "RTN","SCRPW62",37,0) S DIR("?",1)="Specify if you would like the report output to be in delimited format for" "RTN","SCRPW62",38,0) S DIR("?",2)="transfer to a spreadsheet. The delimited output will not include rated SC" "RTN","SCRPW62",39,0) S DIR("?")="disabilities for 0-50% SC veterans (as included in the text formatted report)." "RTN","SCRPW62",40,0) W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 G EXIT "RTN","SCRPW62",41,0) S SDELIM=Y "RTN","SCRPW62",42,0) ; "RTN","SCRPW62",43,0) QUE ;Queue output "RTN","SCRPW62",44,0) ;W !!,"This report requires ",$S(SDELIM:"greater than ",1:""),"132 columns for output!" "RTN","SCRPW62",45,0) W !!,"This report requires the following steps to be converted to 'EXCEL':" "RTN","SCRPW62",46,0) W !,"1 - Copy it into WORD and replace '!^p' with null" "RTN","SCRPW62",47,0) W !,"2 - Save this file as *.txt format" "RTN","SCRPW62",48,0) W !,"3 - Open this file in 'EXCEL' with the All Files(*.*) type of file, listing it with one delimiter: '^'." "RTN","SCRPW62",49,0) F SDX="SDELIM","SDRPT","SDSCVT","SDATES","SDDIV","SDDIV(","SDFMT" S ZTSAVE(SDX)="" "RTN","SCRPW62",50,0) W ! D EN^XUTMDEVQ("START^SCRPW62","SC Veterans Awaiting Appointments",.ZTSAVE) D DISP0^SCRPW23 "RTN","SCRPW62",51,0) Q "RTN","SCRPW62",52,0) ; "RTN","SCRPW62",53,0) ENT ;Date entered parameters "RTN","SCRPW62",54,0) S SDATES=1 Q "RTN","SCRPW62",55,0) ; "RTN","SCRPW62",56,0) ;Following logic suppressed by request "RTN","SCRPW62",57,0) D SUBT^SCRPW50("**** Report Time Frame ****") "RTN","SCRPW62",58,0) S DIR(0)="S^1:THE PAST YEAR;2:THE PAST TWO YEARS;3:THE PAST 3 YEARS" "RTN","SCRPW62",59,0) S DIR("A")="Include SC veterans entered during" "RTN","SCRPW62",60,0) S DIR("?")="Specify the time frame in which these patients were entered in VistA." "RTN","SCRPW62",61,0) W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q "RTN","SCRPW62",62,0) S SDATES=Y "RTN","SCRPW62",63,0) Q "RTN","SCRPW62",64,0) ; "RTN","SCRPW62",65,0) APPT ;Appointment delay parameters "RTN","SCRPW62",66,0) I '$$DIVA^SCRPW17(.SDDIV) S SDOUT=1 Q "RTN","SCRPW62",67,0) S SDATES=30 Q "RTN","SCRPW62",68,0) ; "RTN","SCRPW62",69,0) ;Following logic suppressed by request "RTN","SCRPW62",70,0) D SUBT^SCRPW50("**** Report Time Frame ****") "RTN","SCRPW62",71,0) ; SD*5.3*645 - replaced 'DESIRED DATE' with 'CID/PREFERRED DATE', 'CID/Preferred date' "RTN","SCRPW62",72,0) ;S DIR(0)="S^30:>30 DAYS BEYOND 'DESIRED DATE';60:>60 DAYS BEYOND 'DESIRED DATE;90:>90 DAYS BEYOND 'DESIRED DATE';180:>180 DAYS BEYOND 'DESIRED DATE'" "RTN","SCRPW62",73,0) S DIR(0)="S^30:>30 DAYS BEYOND 'CID/PREFERRED DATE';60:>60 DAYS BEYOND 'CID/PREFERRED DATE;90:>90 DAYS BEYOND 'CID/PREFERRED DATE';180:>180 DAYS BEYOND 'CID/PREFERRED DATE'" "RTN","SCRPW62",74,0) S DIR("A")="Include SC veterans with future appointments greater than" "RTN","SCRPW62",75,0) ;S DIR("?")="Specify the difference between 'desired date' and the appointement date." "RTN","SCRPW62",76,0) S DIR("?")="Specify the difference between 'CID/Preferred date' and the appointement date." "RTN","SCRPW62",77,0) W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q "RTN","SCRPW62",78,0) S SDATES=Y "RTN","SCRPW62",79,0) Q "RTN","SCRPW62",80,0) ; "RTN","SCRPW62",81,0) START ;Gather report data "RTN","SCRPW62",82,0) N SDSTOP,SDOUT,SDSTOP,SDPAGE,SDLINE,SDPNOW,SDT,SDX "RTN","SCRPW62",83,0) I '$D(ZTQUEUED),$E(IOST)="C" D WAIT^DICD "RTN","SCRPW62",84,0) K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT)=0,SDPAGE=1,SDLINE="" "RTN","SCRPW62",85,0) S $P(SDLINE,"-",(IOM+1))="" "RTN","SCRPW62",86,0) S SDPNOW=$$FMTE^XLFDT($E($$NOW^XLFDT(),1,12)) "RTN","SCRPW62",87,0) S SDX=$S(SDSCVT=1:"SC 50-100% ",SDSCVT=2:"SC < 50% ",1:"") "RTN","SCRPW62",88,0) S SDT(1)="<*> SC VETERANS AWAITING APPOINTMENTS <*>" "RTN","SCRPW62",89,0) ; SD*5.3*645 - replaced 'DESIRED DATE' with 'CID/Preferred date' "RTN","SCRPW62",90,0) S SDT(2)=$S(SDRPT="E":SDX_"PATIENTS ENTERED IN THE PAST "_$S(SDATES=1:"YEAR",1:SDATES_" YEARS")_" WITHOUT AN APPOINTMENT",1:SDX_"PATIENTS WAITING > "_SDATES_" DAYS BEYOND APPOINTMENT 'CID/PREFERRED DATE'") "RTN","SCRPW62",91,0) D @(SDRPT_"^SCRPW63") W !! "RTN","SCRPW62",92,0) D EXIT "RTN","SCRPW62",93,0) Q "RTN","SCRPW62",94,0) ; "RTN","SCRPW62",95,0) SCEL(SDE,SDSCVT) ;Gather SC eligibility codes "RTN","SCRPW62",96,0) ;Input: SDE=array to return list of codes in the format SDE(n) where "RTN","SCRPW62",97,0) ; 'n' is the ifn in file #8 (pass by reference) "RTN","SCRPW62",98,0) ; SDSCVT=type of SC vets to include "RTN","SCRPW62",99,0) N SDE81,SDX,SDI,SDII "RTN","SCRPW62",100,0) S SDI=0 F S SDI=$O(^DIC(8.1,SDI)) Q:'SDI D "RTN","SCRPW62",101,0) .S SDX=$G(^DIC(8.1,SDI,0)) "RTN","SCRPW62",102,0) .Q:$P(SDX,U,5)'="Y" S SDX=$P(SDX,U,4) "RTN","SCRPW62",103,0) .I SDSCVT=1,SDX'=1 Q ;50-100% SC only "RTN","SCRPW62",104,0) .I SDSCVT=2,SDX'=3 Q ;0-50% SC only "RTN","SCRPW62",105,0) .I SDSCVT=3,(SDX'=1&(SDX'=3)) Q ;SC only "RTN","SCRPW62",106,0) .S SDII=0 F S SDII=$O(^DIC(8,"D",SDI,SDII)) Q:'SDII D "RTN","SCRPW62",107,0) ..S SDE(SDII)=SDX "RTN","SCRPW62",108,0) ..Q "RTN","SCRPW62",109,0) .Q "RTN","SCRPW62",110,0) Q "RTN","SCRPW62",111,0) ; "RTN","SCRPW62",112,0) EXIT K ZTQUEUED,ZTSTOP,SDATES,SDDIV,SDFMT,SDRPT,SDELIM "RTN","SCRPW62",113,0) D END^SCRPW50 Q "RTN","SCRPW62",114,0) ; "RTN","SCRPW62",115,0) HDR ;Print report header "RTN","SCRPW62",116,0) N X "RTN","SCRPW62",117,0) I SDELIM D HDRD Q "RTN","SCRPW62",118,0) I $E(IOST)="C",SDPAGE>1 N DIR S DIR(0)="E" D ^DIR S SDOUT=Y'=1 Q:SDOUT "RTN","SCRPW62",119,0) D STOP^SCRPW63 Q:SDOUT "RTN","SCRPW62",120,0) W:SDPAGE>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) "RTN","SCRPW62",121,0) W:$X $$XY^SCRPW50("",0,0) W SDLINE "RTN","SCRPW62",122,0) S X=0 F S X=$O(SDT(X)) Q:'X W !?(IOM-$L(SDT(X))\2),SDT(X) "RTN","SCRPW62",123,0) W !,SDLINE,!,"Date printed: ",SDPNOW,?((IOM-6)-$L(SDPAGE)),"Page: " "RTN","SCRPW62",124,0) W SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1 Q "RTN","SCRPW62",125,0) ; "RTN","SCRPW62",126,0) HDRD ;Header for delimited report "RTN","SCRPW62",127,0) Q:SDPAGE>1 "RTN","SCRPW62",128,0) W !,SDLINE S X=0 F S X=$O(SDT(X)) Q:'X W !,SDT(X) "RTN","SCRPW62",129,0) W !,"Date printed: ",SDPNOW,!,SDLINE "RTN","SCRPW62",130,0) N ARR S ARR(1)="NAME^SSN^PRIM. ELIG.^DATE ENTERED^STREET ADDRESS^CITY^STATE^ZIP^PHONE NUMBER" "RTN","SCRPW62",131,0) ; SD*5.3*645 - replaced 'DESIRED DATE' with 'CID/PREFERRED DATE' "RTN","SCRPW62",132,0) S:SDRPT="A" ARR(1)=ARR(1)_"^APPOINTMENT DATE^CLINIC^CREDIT PAIR^DIVISION^DATE APPT. ENTERED^CID/PREFERRED DATE^DIFFERENCE (CID/PREFERRED DATE - APPT. DATE)^DIFFERENCE (DATE APPT. ENTERED - CID/PREFERRED DATE)" "RTN","SCRPW62",133,0) D DELIM(.ARR) "RTN","SCRPW62",134,0) S SDPAGE=SDPAGE+1 Q "RTN","SCRPW62",135,0) Q "RTN","SCRPW62",136,0) ;W !,"NAME^SSN^PRIM. ELIG.^DATE ENTERED^STREET ADDRESS^CITY^STATE^ZIP^PHONE NUMBER" "RTN","SCRPW62",137,0) ;W:SDRPT="A" "^APPOINTMENT DATE^CLINIC^CREDIT PAIR^DIVISION^DATE APPT. ENTERED^DESIRED DATE^DIFFERENCE (DESIRED DATE - APPT. DATE)^DIFFERENCE (DATE APPT. ENTERED - DESIRED DATE)" "RTN","SCRPW62",138,0) ;S SDPAGE=SDPAGE+1 Q "RTN","SCRPW62",139,0) DELIM(ARR) ;enter delimiter in the end of wrapped line "RTN","SCRPW62",140,0) ;ARR - array of lines "RTN","SCRPW62",141,0) N DELIM,II,LN,LL,JJ "RTN","SCRPW62",142,0) S DELIM="!" "RTN","SCRPW62",143,0) F II=1:1 S LN=$G(ARR(II)),LL=$L(LN) Q:'LL S LN=$P(LN," ")_DELIM_$P(LN," ",2,$L(LN," ")) F JJ=1:79:LL W !,$E(LN,JJ,JJ+78) W:JJ+79(IOSL-SDFLEN) D FOOTER(SDREPORT),HDR^SCRPW76(1,SDREPORT,SDIV,SDCP,SC) "RTN","SCRPW77",93,0) ....Q:SDOUT "RTN","SCRPW77",94,0) ....W !,$$DTX(SDI),?13,$E(SDPNAME,1,23),?38,$P(SDATA,U) "RTN","SCRPW77",95,0) ....W ?50,$$DTX(SDADT),?69,$$SRTY($P(SDATA,U,2)) "RTN","SCRPW77",96,0) ....W ?98,$P(SDATA,U,3),?102,$$DTX($P(SDATA,U,4)) "RTN","SCRPW77",97,0) ....W ?115,$S($P(SDATA,U,5)=0:"NO",$P(SDATA,U,5)=1:"YES",1:"") "RTN","SCRPW77",98,0) ....W ?120,$J($P(SDATA,U,7),5,0),?127,$J($P(SDATA,U,6),5,0) "RTN","SCRPW77",99,0) ....Q "RTN","SCRPW77",100,0) ...Q "RTN","SCRPW77",101,0) ..Q "RTN","SCRPW77",102,0) .Q "RTN","SCRPW77",103,0) Q:SDOUT D FOOTER(SDREPORT) "RTN","SCRPW77",104,0) Q "RTN","SCRPW77",105,0) OUT5(DFN,SC) ;Output patient list "RTN","SCRPW77",106,0) N SDY,SDI,SDPNAME,SDADT "RTN","SCRPW77",107,0) I '$O(^TMP("SDIPLST",$J,DFN,SC,0)) D Q "RTN","SCRPW77",108,0) .S SDY="No appointments scheduled during this date range were found." "RTN","SCRPW77",109,0) .W !!?(IOM-$L(SDY)\2),SDY Q "RTN","SCRPW77",110,0) S SDI=0 F S SDI=$O(^TMP("SDIPLST",$J,DFN,SC,SDI)) Q:SDOUT!'SDI D "RTN","SCRPW77",111,0) .S SDPNAME="" "RTN","SCRPW77",112,0) .F S SDPNAME=$O(^TMP("SDIPLST",$J,DFN,SC,SDI,SDPNAME)) Q:SDOUT!(SDPNAME="") D "RTN","SCRPW77",113,0) ..S SDADT=0 "RTN","SCRPW77",114,0) ..F S SDADT=$O(^TMP("SDIPLST",$J,DFN,SC,SDI,SDPNAME,SDADT)) Q:SDOUT!'SDADT D "RTN","SCRPW77",115,0) ...S SDATA=^TMP("SDIPLST",$J,DFN,SC,SDI,SDPNAME,SDADT) "RTN","SCRPW77",116,0) ...I 'SDXM,$Y>(IOSL-SDFLEN) D FOOTER(SDREPORT),HDR^SCRPW76(1,SDREPORT,SDIV,SDCP,SC) "RTN","SCRPW77",117,0) ...Q:SDOUT "RTN","SCRPW77",118,0) ...W !,$$DTXN(SDI),?11,$$SRTY($P(SDATA,U,2)),?31,$$DTXN($P(SDATA,U,4)) "RTN","SCRPW77",119,0) ...W ?42,$$DTXN(SDADT),?52,$J($P(SDATA,U,7),5,0) "RTN","SCRPW77",120,0) ...W ?59,$J($P(SDATA,U,6),5,0),?69,$P(SDATA,U,3) "RTN","SCRPW77",121,0) ...W ?73,$S($P(SDATA,U,5)=0:"NO",$P(SDATA,U,5)=1:"YES",1:"") "RTN","SCRPW77",122,0) ...W ?79,$$DTXN($P(SDATA,U,8)),?96,$P(SDATA,U,9),?102,$P($$DTXN($P(SDATA,U,10)),"@") "RTN","SCRPW77",123,0) ...I +$P(SDATA,U,11)>0 N SDFN,SDARR,DR,DIQ,DIC,DA D W ?113,$G(SDARR(SDFN,DA,DR,"I")) "RTN","SCRPW77",124,0) ....S DR=".01",DIQ="SDARR(",DIQ(0)="I",DIC=200,SDFN=200,DA=$P(SDATA,U,11) D EN^DIQ1 "RTN","SCRPW77",125,0) ...Q "RTN","SCRPW77",126,0) ..Q "RTN","SCRPW77",127,0) .Q "RTN","SCRPW77",128,0) Q:SDOUT D FOOTER(SDREPORT) "RTN","SCRPW77",129,0) Q "RTN","SCRPW77",130,0) ; "RTN","SCRPW77",131,0) SRTY(SDSRTY) ;Externalize scheduling request type "RTN","SCRPW77",132,0) ;Input: SDSRTY=internal value for request type "RTN","SCRPW77",133,0) Q:'$L(SDSRTY) "" "RTN","SCRPW77",134,0) Q:SDSRTY="N" "Next available" "RTN","SCRPW77",135,0) Q:SDSRTY="C" "Not-next ava-C/R" ;Clinician Request "RTN","SCRPW77",136,0) Q:SDSRTY="P" "Not-next ava-P/R" ;Patient Request "RTN","SCRPW77",137,0) Q:SDSRTY="W" "Walk in appoint" "RTN","SCRPW77",138,0) Q:SDSRTY="M" "Multi booking" "RTN","SCRPW77",139,0) Q:SDSRTY="A" "Auto rebook" "RTN","SCRPW77",140,0) Q "Not-next available" "RTN","SCRPW77",141,0) ; "RTN","SCRPW77",142,0) DTX(Y) ;Externalize date "RTN","SCRPW77",143,0) X ^DD("DD") "RTN","SCRPW77",144,0) Q Y "RTN","SCRPW77",145,0) ; "RTN","SCRPW77",146,0) DTXN(Y) ;External date formated to abbreviate "RTN","SCRPW77",147,0) I +Y=0 S Y="" Q Y "RTN","SCRPW77",148,0) X ^DD("DD") "RTN","SCRPW77",149,0) N SDSTR S Y=$P(Y,",")_","_$E($P(Y,",",2),3,10) "RTN","SCRPW77",150,0) I $L(Y)#2=0 S Y=$E(Y,1,3)_" "_$P(Y," ",2) "RTN","SCRPW77",151,0) Q Y "RTN","SCRPW77",152,0) ; "RTN","SCRPW77",153,0) FOOTER(SDREPORT) ;Print footer "RTN","SCRPW77",154,0) ;Input: SDREPORT=report element to print "RTN","SCRPW77",155,0) N SDI,SDFL S SDFL=$S(SDREPORT=1:10,SDREPORT=2:8,SDREPORT=5:13,1:9) "RTN","SCRPW77",156,0) I SDXM D Q "RTN","SCRPW77",157,0) .D XMTX^SCRPW73(" ") S SDI=0 "RTN","SCRPW77",158,0) .F S SDI=$O(SDFOOT(SDREPORT,SDI)) Q:'SDI D XMTX^SCRPW73(SDFOOT(SDREPORT,SDI)) "RTN","SCRPW77",159,0) .Q "RTN","SCRPW77",160,0) F SDI=1:1:80 Q:$Y>(IOSL-SDFL) W ! "RTN","SCRPW77",161,0) S SDI=0 "RTN","SCRPW77",162,0) F S SDI=$O(SDFOOT(SDREPORT,SDI)) Q:'SDI W !,SDFOOT(SDREPORT,SDI) "RTN","SCRPW77",163,0) Q "RTN","SCRPW77",164,0) ; "RTN","SCRPW77",165,0) FOOT(SDTX) ;Report footer for retrospective report "RTN","SCRPW77",166,0) ;Input: SDTX=array to return text "RTN","SCRPW77",167,0) I $G(SDREPORT(1)) D "RTN","SCRPW77",168,0) .S SDTX(1,1)=SDLINE "RTN","SCRPW77",169,0) .S SDTX(1,2)="NOTE: TYPE '0' represents appointments scheduled during the report time frame not indicated by the user or by calculation to be" "RTN","SCRPW77",170,0) .S SDTX(1,3)="'next available' appointments. TYPE '1' represents appointments defined by the user as being 'next available' appointments. TYPE" "RTN","SCRPW77",171,0) .S SDTX(1,4)="'2' represents appointments calculated to be 'next available' appointments. TYPE '3' represents appointments indicated both by the" "RTN","SCRPW77",172,0) .S SDTX(1,5)="user and by calculation to be 'next available' appointments. WAIT TIME is the average number of days from the date an appointment" "RTN","SCRPW77",173,0) .S SDTX(1,6)="was scheduled to the date it is to be performed. The '% NNA' and '% NA' columns reflect percentage of appointments scheduled within" "RTN","SCRPW77",174,0) .S SDTX(1,7)="30 days for 'non-next available' appointments (types 0 & 2) and 'next available' appointments (types 1 & 3), respectively." "RTN","SCRPW77",175,0) .S SDTX(1,8)=SDLINE Q "RTN","SCRPW77",176,0) I $G(SDREPORT(2)) D "RTN","SCRPW77",177,0) .S SDTX(2,1)=SDLINE "RTN","SCRPW77",178,0) .; SD*5.3*645 - replaced 'desired date' with 'CID/Preferred Date' when presented to the user "RTN","SCRPW77",179,0) .;S SDTX(2,2)="NOTE: The date range categories ('0-1', '2-7', '8-30', etc.) are based on the difference between the 'desired date' defined for the" "RTN","SCRPW77",180,0) .S SDTX(2,2)="NOTE: The date range categories ('0-1', '2-7', '8-3, etc.) are based on the difference between the 'CID/Preferred Date' defined for the" "RTN","SCRPW77",181,0) .S SDTX(2,3)="appointment and the date the appointment was performed. 'Wait Time' reflects the average of this difference for all appointments in" "RTN","SCRPW77",182,0) .S SDTX(2,4)="each category. 'Follow up' status is determined by encounter activity to the same DSS ID credit pair as the appointment clinic" "RTN","SCRPW77",183,0) .S SDTX(2,5)="within the previous 24 months." "RTN","SCRPW77",184,0) .S SDTX(2,6)=SDLINE Q "RTN","SCRPW77",185,0) I $G(SDREPORT(3)) D "RTN","SCRPW77",186,0) .S SDTX(3,1)=SDLINE "RTN","SCRPW77",187,0) .;SD*5.3*645 - replaced 'desired date' with 'CID/Preferred date' when presented to the user "RTN","SCRPW77",188,0) .;S SDTX(3,2)="NOTE: The date range categories ('0-1', '2-7', '8-30', etc.) are based on the difference between the 'desired date' defined for the" "RTN","SCRPW77",189,0) .S SDTX(3,2)="NOTE: The date range categories ('0-1', '2-7', '8-30, etc.) are based on the difference between the 'CID/Preferred Date' defined for the" "RTN","SCRPW77",190,0) .S SDTX(3,3)="appointment and the date the appointment was performed. 'Wait Time1' reflects the average difference between the 'CID/Preferred Date' and" "RTN","SCRPW77",191,0) .S SDTX(3,4)="the date the appointment was performed. 'Wait Time2' reflects the average difference between the transaction date (the date the" "RTN","SCRPW77",192,0) .S SDTX(3,5)="appointment was entered by the Scheduling package user) and the date the appointment was performed. 'Non-follow up' status is" "RTN","SCRPW77",193,0) .S SDTX(3,6)="determined by the absence of encounter activity to the same DSS ID credit pair as the appointment clinic in the previous 24 months." "RTN","SCRPW77",194,0) .S SDTX(3,7)=SDLINE Q "RTN","SCRPW77",195,0) I $G(SDREPORT(4)) D "RTN","SCRPW77",196,0) .S SDTX(4,1)=SDLINE "RTN","SCRPW77",197,0) .S SDTX(4,2)="NOTE: 'Next Ava. Ind.' Values--'0' = not indicated by the user or calculation to be a 'next available' appointment, '1' = defined" "RTN","SCRPW77",198,0) .S SDTX(4,3)="by the user as a 'next available' appointment, '2' = indicated by calculation to be a 'next available' appointment, '3' = indicated" "RTN","SCRPW77",199,0) .S SDTX(4,4)="by the user and by calculation to be a 'next available' appointment. 'Wait Time1' = the difference between the 'CID/Preferred Date' and" "RTN","SCRPW77",200,0) .S SDTX(4,5)="the date of the appointment. 'Wait Time2' = the difference between the 'date scheduled' and the date of the appointment." "RTN","SCRPW77",201,0) .S SDTX(4,6)=SDLINE Q "RTN","SCRPW77",202,0) I $G(SDREPORT(5)) D FOOT^SCRPW78(.SDTX,SDLINE) Q "RTN","SCRPW77",203,0) Q "RTN","SCRPW78") 0^2^B20645395^B18943883 "RTN","SCRPW78",1,0) SCRPW78 ;BP-CIOFO/ESW - Clinic appointment availability extract ;1/5/16 12:24pm "RTN","SCRPW78",2,0) ;;5.3;Scheduling;**291,645**;AUG 13, 1993;Build 7 "RTN","SCRPW78",3,0) ; "RTN","SCRPW78",4,0) Q ; Must not call this routine directly "RTN","SCRPW78",5,0) ; "RTN","SCRPW78",6,0) SELECT(SDJN,SDPAT) N SDPT,DIC,Y S SDPT=0 N % S %=0 F Q:(%=1&'SDPT) S DIC=2,DIC(0)="QEAMIZ",DIC("A")="Select PATIENT NAME:" D ^DIC D "RTN","SCRPW78",7,0) .S SDPT=+Y "RTN","SCRPW78",8,0) .I SDPT>0 W !,"Correct Patient? " S %=1 D YN^DICN D:(%=1) Q "RTN","SCRPW78",9,0) ..N SS S SS=$O(^TMP("SDPAT",SDJN,""),-1) "RTN","SCRPW78",10,0) ..S ^TMP("SDPAT",SDJN,SS+1)=SDPT_U_$P(^DPT(SDPT,0),U),SDPAT=SDPAT+1 "RTN","SCRPW78",11,0) .I SDPT<0,SDPAT S %=1,SDPT=0 W !,SDPAT_" patient(s) selected",! Q "RTN","SCRPW78",12,0) .I SDPT<0 W !,"No Patient Selected, OK to proceed? " S %=1 D YN^DICN S SDPT=0 "RTN","SCRPW78",13,0) Q "RTN","SCRPW78",14,0) PRT5 ;print SDREPORT=5 "RTN","SCRPW78",15,0) I $G(SDREPORT)'=5 Q "RTN","SCRPW78",16,0) N SC,DFN,SDIV,SDCP,SDDV,SDIVC,SDPNAME S DFN="" "RTN","SCRPW78",17,0) S SDPNAME="" F S SDPNAME=$O(^TMP("SDORD",$J,SDPNAME)) Q:SDPNAME=""!SDOUT D "RTN","SCRPW78",18,0) .S DFN="" F S DFN=$O(^TMP("SDORD",$J,SDPNAME,DFN)) Q:DFN="" D "RTN","SCRPW78",19,0) ..S SDIV="" F S SDIV=$O(^TMP("SDIP",$J,SDIV)) Q:SDIV=""!SDOUT D "RTN","SCRPW78",20,0) ...S SC="" "RTN","SCRPW78",21,0) ...F S SC=$O(^TMP("SDIP",$J,SDIV,SC)) Q:SC="" I $D(^TMP("SDIPLST",$J,DFN,SC)) D "RTN","SCRPW78",22,0) ....S SDCP=$P(^TMP("SDIP",$J,SDIV,SC),U),SDDV=$P(^(SC),U,2) "RTN","SCRPW78",23,0) ....S SDIVC=SDDV_U_SDIV "RTN","SCRPW78",24,0) ....D HDR^SCRPW76(1,SDREPORT,SDIVC,SDCP,SC) Q:SDOUT "RTN","SCRPW78",25,0) ....D OUT5^SCRPW77(DFN,SC) Q "RTN","SCRPW78",26,0) Q "RTN","SCRPW78",27,0) GEN5A(SDAP0,DFN,SDADT,SDCL,SDWAIT,SDT,SDSFU,SDSDEV,SDSDDT,SDFLAG) ;generate ^TMP("SDIPLST" for a selected patient "RTN","SCRPW78",28,0) ;SDAP0 - zero node of appointment multiple "RTN","SCRPW78",29,0) ; ^DPT(DFN,"S",SDADT,0) "RTN","SCRPW78",30,0) ; "RTN","SCRPW78",31,0) N SDPNAME,SDATA,SDSSN,SDREB,SDCMPL,SDSCHED,SDAST,SDASTO "RTN","SCRPW78",32,0) ;Get appointment status, rebook date, completion date and scheduler "RTN","SCRPW78",33,0) S SDAST=$P(SDAP0,U,2) S SDASTO=$S(SDAST="C":"CC",SDAST="CA":"CCA",SDAST="PC":"CP",SDAST="PCA":"CPA",1:SDAST) "RTN","SCRPW78",34,0) I SDASTO="" D "RTN","SCRPW78",35,0) .N SDATC S SDATC=$$STATUS^SDAM1(DFN,SDADT,SDCL,SDAP0) "RTN","SCRPW78",36,0) .I +SDATC=2 D Q "RTN","SCRPW78",37,0) ..S SDASTO="CO" "RTN","SCRPW78",38,0) ..I $P(SDATC,";",3)["ACT REQ" S SDASTO="COA" "RTN","SCRPW78",39,0) .I +SDATC=11 S SDASTO="F" Q "RTN","SCRPW78",40,0) .I +SDATC=3 S SDASTO="NT" Q "RTN","SCRPW78",41,0) .I +SDATC=1 S SDASTO="CI" "RTN","SCRPW78",42,0) S SDREB=$P(SDAP0,U,10),SDCMPL=$P(SDAP0,U,14) S SDSCHED=$P($G(^SC(SDCL,"S",SDADT,1,1,0)),U,6) I SDSCHED="" S SDSCHED=$P(SDAP0,U,18) "RTN","SCRPW78",43,0) I SDASTO="CO" D "RTN","SCRPW78",44,0) .N SDE S SDE=$P(SDAP0,U,20),SDCMPL=$P(^SCE(SDE,0),U,7) "RTN","SCRPW78",45,0) S SDATA=$G(^DPT(DFN,0)) "RTN","SCRPW78",46,0) S SDSSN=$P(SDATA,U,9),SDPNAME=$P(SDATA,U) Q:'$L(SDPNAME) "RTN","SCRPW78",47,0) S SDATA=SDSSN_U_$P(SDAP0,U,25)_U_SDFLAG_U_SDSDDT_U_SDSFU_U_SDWAIT_U_SDSDEV_U_SDREB_U_SDASTO_U_SDCMPL_U_SDSCHED "RTN","SCRPW78",48,0) S ^TMP("SDIPLST",$J,DFN,SDCL,SDT,SDPNAME,SDADT)=SDATA "RTN","SCRPW78",49,0) Q "RTN","SCRPW78",50,0) FOOT(SDTX,SDLINE) ; "RTN","SCRPW78",51,0) I $G(SDREPORT(5)) D "RTN","SCRPW78",52,0) .S SDTX(5,1)=SDLINE "RTN","SCRPW78",53,0) .S SDTX(5,2)="NOTE: 'APPT TYPE' Values--'0' = user indicated 'Not next available' and calculation indicated 'Not next available' used" "RTN","SCRPW78",54,0) .S SDTX(5,3)=" '1' = user indicated 'Next available' but calculation indicated next available appt not used" "RTN","SCRPW78",55,0) .S SDTX(5,4)=" '2' = user indicated 'Not next available' but calculation indicated next available appointment used" "RTN","SCRPW78",56,0) .S SDTX(5,5)=" '3' = user indicated 'Next available' and calculation indicated 'Next available' appointment used" "RTN","SCRPW78",57,0) .; SD*5.3*645 - replaced 'DATE DESIRED' with 'CID/PREFERRED DATE' when presented to the user "RTN","SCRPW78",58,0) .;S SDTX(5,6)="WAIT TIME: -------------- the difference between the 'DATE DESIRED' and 'APPT DATE/TIME'" "RTN","SCRPW78",59,0) .S SDTX(5,6)="WAIT TIME: -------------- the difference between the 'CID/PREFERRED DATE' and 'APPT DATE/TIME'" "RTN","SCRPW78",60,0) .S SDTX(5,7)="TIME TO APPT.: ----------- days from 'DATE SCHEDULED' to 'APPT DATE/TIME'" "RTN","SCRPW78",61,0) .S SDTX(5,8)="APPT STATUS: N - No-show, CC - Canceled by Clinic, NA - No Show & Auto Rebook, CCA -Canceled by Clinic & Auto Rebook," "RTN","SCRPW78",62,0) .S SDTX(5,9)=" I - Inpatient, CP - Canceled by Patient, CPA - Canceled by Patient & Auto Rebook, NT - No Action Taken," "RTN","SCRPW78",63,0) .S SDTX(5,10)=" F - Future, CI - Checked In, COA - Checked Out/Action Required, CO - Checked Out" "RTN","SCRPW78",64,0) .S SDTX(5,11)=SDLINE Q "RTN","SCRPW78",65,0) Q "RTN","SDAMEP3") 0^3^B21041626^B19773146 "RTN","SDAMEP3",1,0) SDAMEP3 ;ALB/CAW - Extended Display (Appt. Event Log) ;1/5/16 12:24pm "RTN","SDAMEP3",2,0) ;;5.3;Scheduling;**20,241,645**;Aug 13, 1993;Build 7 "RTN","SDAMEP3",3,0) ; "RTN","SDAMEP3",4,0) APLOG ; "RTN","SDAMEP3",5,0) D SET^SDAMEP1(" *** Appointment Event Log ***") "RTN","SDAMEP3",6,0) D CNTRL^VALM10(SDLN,24,29,IOINHI,IOINORM) "RTN","SDAMEP3",7,0) D SET^SDAMEP1($$EVENT("Event","Date","User")) "RTN","SDAMEP3",8,0) D SET^SDAMEP1($$EVENT("-----","----","----")) "RTN","SDAMEP3",9,0) D SET^SDAMEP1($$EVENT("Appt Made",$S($G(SDSC(44.003,SDDA,8))]"":SDSC(44.003,SDDA,8),1:$G(SDPT(2.98,SDT,20))),$S($G(SDSC(44.003,SDDA,7))]"":SDSC(44.003,SDDA,7),1:$G(SDPT(2.98,SDT,19))))) "RTN","SDAMEP3",10,0) D SET^SDAMEP1($$EVENT("Check In",$G(SDSC(44.003,SDDA,309)),$G(SDSC(44.003,SDDA,302)))) "RTN","SDAMEP3",11,0) D SET^SDAMEP1($$EVENT("Check Out",$G(SDSC(44.003,SDDA,303)),$G(SDSC(44.003,SDDA,304)))) "RTN","SDAMEP3",12,0) D SET^SDAMEP1($$EVENT("Check Out Entered",$G(SDSC(44.003,SDDA,306)),"")) "RTN","SDAMEP3",13,0) D SET^SDAMEP1($$EVENT("No-Show/Cancel",$G(SDPT(2.98,SDT,15)),$G(SDPT(2.98,SDT,14)))),SET^SDAMEP1("") "RTN","SDAMEP3",14,0) ; "RTN","SDAMEP3",15,0) S X="" "RTN","SDAMEP3",16,0) S X=$$SETSTR^VALM1(" Checked Out:",X,7,SDWIDTH) "RTN","SDAMEP3",17,0) S X=$$SETSTR^VALM1($S($G(SDOE(409.68,+SDOE,.07))]"":"YES",1:""),X,SDFSTCOL+5,30) "RTN","SDAMEP3",18,0) D SET^SDAMEP1(X) "RTN","SDAMEP3",19,0) ; "RTN","SDAMEP3",20,0) S X="" "RTN","SDAMEP3",21,0) S X=$$SETSTR^VALM1(" Cancel Reason:",X,5,SDWIDTH) "RTN","SDAMEP3",22,0) S X=$$SETSTR^VALM1(SDPT(2.98,SDT,16),X,SDFSTCOL+5,30) "RTN","SDAMEP3",23,0) D SET^SDAMEP1(X) "RTN","SDAMEP3",24,0) ; "RTN","SDAMEP3",25,0) S X="" "RTN","SDAMEP3",26,0) S X=$$SETSTR^VALM1(" Cancel Remark:",X,5,SDWIDTH) "RTN","SDAMEP3",27,0) S X=$$SETSTR^VALM1(SDPT(2.98,SDT,17),X,SDFSTCOL+5,50) "RTN","SDAMEP3",28,0) D SET^SDAMEP1(X) "RTN","SDAMEP3",29,0) ; "RTN","SDAMEP3",30,0) S X="" "RTN","SDAMEP3",31,0) S X=$$SETSTR^VALM1(" Rebooked Date:",X,5,SDWIDTH) "RTN","SDAMEP3",32,0) S X=$$SETSTR^VALM1(SDPT(2.98,SDT,12),X,SDFSTCOL+5,20) "RTN","SDAMEP3",33,0) D SET^SDAMEP1(X) "RTN","SDAMEP3",34,0) CWT ;Clinic Wait Time Information "RTN","SDAMEP3",35,0) N SDCWT,SDCWT1,SDCWT2 "RTN","SDAMEP3",36,0) ;Get internal data values "RTN","SDAMEP3",37,0) F SDCWT=3,20,25:1:28 S SDCWT(SDCWT)=SDPTI(2.98,SDT,SDCWT,"I") "RTN","SDAMEP3",38,0) ;Wait time data applicable? "RTN","SDAMEP3",39,0) S SDCWT=1 S:$E(SDCWT(3))="C" SDCWT=0 "RTN","SDAMEP3",40,0) S SDCWT1=SDCWT(20),SDCWT2=SDCWT(27) "RTN","SDAMEP3",41,0) ;Calculate Wait Time1 "RTN","SDAMEP3",42,0) S SDCWT1=$S(SDCWT1<1:"",SDTY!('SDRE) S SDHY=Y,Y=SDINA D DTS^SDUTL W !,*7,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"") S Y=SDHY K SDHY D PAUSE^VALM1 Q:'SDRE "RTN","SDM0",35,0) S:Y#100=0 Y=Y+1 S X=Y D D:$E(X,4,5) S (SDX,X1)=X,X2=1 D C^%DTC S X=SDX K SDX G:SDAV ^SDM1 Q "RTN","SDM0",36,0) ; "RTN","SDM0",37,0) NEXT D SET I $S('$D(FND):1,'FND:1,1:0) D G EN "RTN","SDM0",38,0) .K ^DISV($S($D(DUZ)'[0:DUZ,1:0)_U_+SC) "RTN","SDM0",39,0) .I '$O(^SC(+SC,"ST",SDDATE-1)) S (X,Y)=SDDATE Q "RTN","SDM0",40,0) .W $C(7),!?6,"No open slots found in the date range " "RTN","SDM0",41,0) .W $$FMTE^XLFDT(SDDATE)," to ",$$FMTE^XLFDT(SDDMAX),"!",! "RTN","SDM0",42,0) .H 3 S (X,Y)=SDDATE "RTN","SDM0",43,0) .Q "RTN","SDM0",44,0) S (X,Y)=SDAPP K SDXXX G DISP "RTN","SDM0",45,0) ; SD*5.3*622 - display clinic name all the time "RTN","SDM0",46,0) D W #!?36,$P(^SC(+SC,0),U,1) S:$O(^SC(+SC,"T",0))>X X=+$O(^(0)) D DOW S I=Y+32,D=Y S SDXF=0 D WM I SDXF D WMH "RTN","SDM0",47,0) X1 S X1=X\100_$P("31^28^31^30^31^30^31^31^30^31^30^31",U,+$E(X,4,5)) ;28 "RTN","SDM0",48,0) ;SD*5.3*547 next line don't allow past dates to be added to pattern if prior to date DOW was added "RTN","SDM0",49,0) W I '$D(^SC(+SC,"ST",X,1)) S DWFLG=1,POP=0,XDT=X D DOWCHK K DWFLG,XDT G L:POP "RTN","SDM0",50,0) I '$D(^SC(+SC,"ST",X,1)) S Y=D#7 G L:'$D(J(Y)),H:$D(^HOLIDAY(X))&('SDSOH) S SS=+$O(^SC(+SC,"T"_Y,X)) G L:SS'>0,L:^(SS,1)="" S ^SC(+SC,"ST",$P(X,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(X,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(X,".") "RTN","SDM0",51,0) S SDHX=X,SDAV=1 D:X>SM WM I SDXF<2 D WMH "RTN","SDM0",52,0) I $D(^SC(+SC,"ST",X,1)),^(1)["["!(^(1)["CANCELLED")!($D(^HOLIDAY(X))) W !,$E(^SC(+SC,"ST",X,1),1,80) S:'$D(^HOLIDAY(X))&('SDAV) SDAV=1 "RTN","SDM0",53,0) I $Y>18 W ! Q "RTN","SDM0",54,0) L K POP "RTN","SDM0",55,0) S X=X+1,D=D+1 "RTN","SDM0",56,0) I $D(SDINA),X>SDINA,SDRE>X!('SDRE) D:'SDAV NOAV S SDHY=Y,Y=SDINA D DTS^SDUTL W !,*7,?8,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"") S Y=SDHY K SDHY Q:'SDRE D DIFF "RTN","SDM0",57,0) G W:X'>X1 S X2=X-X1 D C^%DTC "RTN","SDM0",58,0) I $D(SDINA),X>SDINA,SDRE>X!('SDRE) D:'SDAV NOAV S SDHY=Y,Y=SDINA D DTS^SDUTL W !,*7,?8,"Clinic is inactive ",$S(SDRE:"from ",1:"as of "),Y S Y=SDRE D:Y DTS^SDUTL W $S(SDRE:" to "_Y,1:"") S Y=SDHY K SDHY Q:'SDRE "RTN","SDM0",59,0) G X1:D20 D "RTN","SDM0",66,0) . S SDXD=$O(^SC(+SC,"ST",X-1)) Q:SDXD="" "RTN","SDM0",67,0) . I $E(SDXD,4,5)'=$E(X,4,5) S SDXF=0 "RTN","SDM0",68,0) D:SDXF DT "RTN","SDM0",69,0) Q "RTN","SDM0",70,0) WMH ;Write month heading lines "RTN","SDM0",71,0) W !!," TIME",?SI+SI-1 F Y=STARTDAY:1:65\(SI+SI)+STARTDAY W $E("|"_$S('Y:0,1:(Y-1#12+1))_" ",1,SI+SI) "RTN","SDM0",72,0) W !," DATE",?SI+SI-1,"|" K J F Y=0:1:6 I $D(^SC(+SC,"T"_Y)) S J(Y)="" "RTN","SDM0",73,0) F Y=1:1:65\(SI+SI) W $J("|",SI+SI) "RTN","SDM0",74,0) S SDXF=2 "RTN","SDM0",75,0) Q "RTN","SDM0",76,0) DT W $$FMTE^XLFDT(Y) Q "RTN","SDM0",77,0) ; "RTN","SDM0",78,0) DOW S Y=$$DOW^XLFDT(X,1) Q "RTN","SDM0",79,0) ; "RTN","SDM0",80,0) DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR "RTN","SDM0",81,0) MORDIS I '$D(SDHX) W *7," ??" G ADT^SDM1 "RTN","SDM0",82,0) S SDXF=0,X1=SDHX,X2=1 D C^%DTC "RTN","SDM0",83,0) MORD2 I $D(SDINA),SDINA'>X,SDRE>X!('SDRE) S SDHY=$S($D(Y):Y,1:""),Y=SDINA D DTS^SDUTL W *7,!,"Clinic is inactivated as of ",Y S Y=SDHY K SDHY G ADT^SDM1 "RTN","SDM0",84,0) G EN "RTN","SDM0",85,0) INPAT S SDI=$O(^DGPM("ATID1",DFN,9999999-X)) I SDI>0 D I1 "RTN","SDM0",86,0) S:'$D(SDINP) SDINP="" K SDI,SDI1 Q "RTN","SDM0",87,0) I1 F SDI1=0:0 S SDI1=$O(^DGPM("ATID1",DFN,SDI,SDI1)) Q:SDI1'>0 I $D(^DGPM(SDI1,0)) S SDX=^(0) I $S($P(SDX,U,17)']"":1,+^DGPM($P(SDX,U,17),0)>X!(+^DGPM($P(SDX,U,17),0)=0):1,1:0) S SDINP="I" Q "RTN","SDM0",88,0) Q "RTN","SDM0",89,0) ; "RTN","SDM0",90,0) SUP ;Set up variables for availability search "RTN","SDM0",91,0) S SDNEXT=1,SDCT=1,G1=+SC,SDC(1)=SC,FND=0,SDAV=0 K SDC1 "RTN","SDM0",92,0) D SAVE S IOP=$S($D(ION):ION,1:"HOME") D ^%ZIS K IOP "RTN","SDM0",93,0) Q "RTN","SDM0",94,0) ; "RTN","SDM0",95,0) SET S I1="" F I=0:0 S I1=$O(SDZ(I1)) Q:I1']"" S @I1=SDZ(I1) "RTN","SDM0",96,0) K SDZ Q "RTN","SDM0",97,0) SAVE K SDZ F I="SDDIF","STR","SC","DFN","SL","SI","HSI","SB" S Z="SDZ("_""""_I_""")" S:$D(@I) @Z=@I "RTN","SDM0",98,0) Q "RTN","SDM0",99,0) MNTH W !," *** No availability found for one full calendar month",!," Search stopped at " S Y=X D DTS^SDUTL W Y," ***",! Q "RTN","SDM0",100,0) DIFF S X1=SDRE,X2=X D ^%DTC S D=D+X,X=SDRE,X1=X\100_28 Q "RTN","SDM0",101,0) ; "RTN","SDM0",102,0) SRTY(SDSRTY) ;Prompt for scheduling request type "RTN","SDM0",103,0) ;Input: SDSRTY=variable to return user response (pass by reference) "RTN","SDM0",104,0) ;Output: '1' if successful, '0' otherwise "RTN","SDM0",105,0) ; "RTN","SDM0",106,0) I $G(DFN)<1 S SDSRTY="M" Q 1 ;patient not defined "RTN","SDM0",107,0) I $G(SDMM)=1 S SDSRTY="M" Q 1 ;multiple appointment booking "RTN","SDM0",108,0) N DIR,DTOUT,DUOUT "RTN","SDM0",109,0) S DIR(0)="Y" "RTN","SDM0",110,0) S DIR("A")="IS THIS A 'NEXT AVAILABLE' APPOINTMENT REQUEST" "RTN","SDM0",111,0) S DIR("?")="Answer 'yes' if scheduling to the next available appointment is desired." "RTN","SDM0",112,0) W ! D ^DIR I $D(DTOUT)!$D(DUOUT) Q 0 "RTN","SDM0",113,0) S SDSRTY=Y,SDSRTY(0)=$$TXRT^SDM1A(.SDSRTY) Q 1 "RTN","SDM0",114,0) ; "RTN","SDM0",115,0) PTFU(DFN,SC) ;Determine if this is a follow-up (return to clinic within 24 months) "RTN","SDM0",116,0) ;Input: DFN=patient ifn "RTN","SDM0",117,0) ;Input: SC=clinic ifn "RTN","SDM0",118,0) ;Output: '1' if seen within 24 months, '0' otherwise "RTN","SDM0",119,0) ; "RTN","SDM0",120,0) Q:'DFN!'SC 0 ;variable check "RTN","SDM0",121,0) N SDBDT,SDT,SDX,SDY,SDZ,SDCP,SDCP1,SC0,SDENC,SDCT "RTN","SDM0",122,0) ;set up variables "RTN","SDM0",123,0) S SDBDT=(DT-20000)+.24,SDT=DT_.999999,(SDCT,SDY)=0 "RTN","SDM0",124,0) S SC0=$G(^SC(+SC,0)),SDX=$$CPAIR^SCRPW71(SC0,.SDCP) ;get credit pair for this clinic "RTN","SDM0",125,0) ;Iterate through encounters "RTN","SDM0",126,0) W !!,"Calculating follow-up status" "RTN","SDM0",127,0) F S SDT=$O(^SCE("ADFN",DFN,SDT),-1) Q:SDT0 W !?5,"Date/time",?19,"to schedule a specific appointment - Note: PAST dates",!?19,"must include the Year in the input." ;added note SD*5.3*547 "RTN","SDM0",153,0) W !?5,"'?'",?19,"for detailed help" "RTN","SDM0",154,0) DASK N DIR,X,Y,SDX,DTOUT,DUOUT "RTN","SDM0",155,0) ; "RTN","SDM0",156,0) ;BP OIFO/TEH PATCH SD*5.3*384 ; SD*5.3*547 added note to help text "RTN","SDM0",157,0) ; "RTN","SDM0",158,0) S DIR(0)="F^1:30" "RTN","SDM0",159,0) ; SD*5.3*645 - replaced DATE DESIRED with CID/PREFERRED DATE "RTN","SDM0",160,0) ; S DIR("A")="ENTER THE DATE DESIRED FOR THIS APPOINTMENT" "RTN","SDM0",161,0) S DIR("A")="ENTER THE CID/PREFERRED DATE FOR THIS APPOINTMENT" "RTN","SDM0",162,0) S DIR("?",1)=" Enter the date that is desired for this appointment." "RTN","SDM0",163,0) S DIR("?",2)=" NOTE: PAST dates must include the Year in the input." "RTN","SDM0",164,0) S DIR("?",3)="" "RTN","SDM0",165,0) S DIR("?",4)=" You may enter 'F' to find the first available slot after a specified date." "RTN","SDM0",166,0) S DIR("?",5)=" You will be prompted for begin and end dates for this search." "RTN","SDM0",167,0) S DIR("?",6)="" "RTN","SDM0",168,0) S DIR("?",7)=" A date may be entered to begin the display of clinic availability at the" "RTN","SDM0",169,0) I DFN<1 S DIR("?")=" requested date." "RTN","SDM0",170,0) I DFN>0 D "RTN","SDM0",171,0) .S DIR("?",8)=" requested date." "RTN","SDM0",172,0) .S DIR("?",9)="" "RTN","SDM0",173,0) .S DIR("?",10)=" The entry of a date/time will result in the scheduling of an appointment at" "RTN","SDM0",174,0) .S DIR("?")=" that time, if possible." "RTN","SDM0",175,0) .Q "RTN","SDM0",176,0) W ! D ^DIR Q:$D(DTOUT)!$D(DUOUT) 0 "RTN","SDM0",177,0) I Y=" " S SDX=$G(^DISV(DUZ_U_+SC)) I SDX?7N S (X,Y)=SDX "RTN","SDM0",178,0) I $L(Y)=1,"fF"[Y D Q 1 "RTN","SDM0",179,0) .W " First available" "RTN","SDM0",180,0) .S (SDDATE,SDSRTY)=$TR(Y,"f","F") "RTN","SDM0",181,0) .Q "RTN","SDM0",182,0) N %DT,SDX,SDI,POP "RTN","SDM0",183,0) S SDX="N^n^NOW^now^Now" F SDI=1:1:5 S:X=$P(SDX,U,SDI) X="T" "RTN","SDM0",184,0) S %DT="EFT" D ^%DT "RTN","SDM0",185,0) G:Y<1 DASK S SDDATE=Y "RTN","SDM0",186,0) I DFN<1 S SDDATE=SDDATE\1 "RTN","SDM0",187,0) ;SD*5.3*621 - check if desired date if prior to DOB and if clinic schedule is available. "RTN","SDM0",188,0) I DFN>0 S POP=0 D DDCHK I POP G DASK "RTN","SDM0",189,0) I DFN>0,Y'SDMAX D G DASK "RTN","SDM0",190,0) .W !,$C(7) "RTN","SDM0",191,0) .W "Scheduling cannot be more than ",SDMAX(1)," days in the future" "RTN","SDM0",192,0) .Q "RTN","SDM0",193,0) Q 1 "RTN","SDM0",194,0) ; "RTN","SDM0",195,0) DDCHK ;SD*5.3*621 - check if desired date if prior to DOB and if clinic schedule is available. "RTN","SDM0",196,0) N X "RTN","SDM0",197,0) S X=SDDATE D AVCHK^SDM1 I POP Q "RTN","SDM0",198,0) D AVCHK1^SDM1 "RTN","SDM0",199,0) Q "RTN","SDM0",200,0) ; "RTN","SDM0",201,0) DOWCHK ;SD*5.3*547 check if date is prior to date DOW was added to pattern "RTN","SDM0",202,0) S (DY,DYW)="" S:'$D(DWFLG) DWFLG=0 "RTN","SDM0",203,0) I '$D(^SC(+SC,"ST",$P(XDT,"."),1)) D Q:DWFLG I POP D DWWRT Q "RTN","SDM0",204,0) .S DY=$$DOW^XLFDT($P(XDT,".")) "RTN","SDM0",205,0) .S DYW=$E(DY,1,2),DYW=$TR(DYW,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","SDM0",206,0) .S PCDT=$P(XDT,"."),CT=0,POP=1 "RTN","SDM0",207,0) .F S PCDT=$O(^SC(+SC,"ST",PCDT),-1) Q:'PCDT!('POP)!(CT>30) D "RTN","SDM0",208,0) ..S CT=CT+1 "RTN","SDM0",209,0) ..Q:'$D(^SC(+SC,"ST",PCDT,0)) "RTN","SDM0",210,0) ..Q:'$D(^SC(+SC,"ST",PCDT,1)) "RTN","SDM0",211,0) ..Q:$E($G(^SC(+SC,"ST",PCDT,1)),1,2)'=DYW "RTN","SDM0",212,0) ..I $E($G(^SC(+SC,"ST",PCDT,1)),1,2)=DYW S POP=0 Q "RTN","SDM0",213,0) .Q "RTN","SDM0",214,0) K PCDT,CT,DY,DYW "RTN","SDM0",215,0) Q "RTN","SDM0",216,0) ; "RTN","SDM0",217,0) DWWRT ;added SD*5.3*547 "RTN","SDM0",218,0) S DY=$TR(DY,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") "RTN","SDM0",219,0) W *7,!!,"That date is prior to the date ",DY," was added to the" "RTN","SDM0",220,0) W !,"availability pattern for this clinic.",!! "RTN","SDM0",221,0) K DY,DYW,PCDT,CT "RTN","SDM0",222,0) Q "RTN","SDM0",223,0) ; "RTN","SDM0",224,0) 1 S SDNEXT="",SDCT=0 G RD^SDMULT "RTN","SDM0",225,0) DT1 S FND=0,%DT(0)=-SDMAX,%DT="AEF",%DT("A")=" START SEARCH FOR NEXT AVAILABLE FROM WHAT DATE: " D ^%DT K %DT G:"^"[X 1:$S('$D(SDNEXT):1,'SDNEXT:1,1:0),END^SDMULT0 G:Y<0 DT S (SDDATE,SDSTRTDT)=+Y "RTN","SDM0",226,0) LIM W !," ENTER LATEST DATE TO CHECK FOR 1ST AVAILABLE SLOT: " S Y=SDMAX D DT^DIQ R "// ",X:DTIME G:X["^"!'($T) END^SDMULT0 I X']"" G OVR^SDMULT0 "RTN","SDM0",227,0) I X?.E1"?" W !," The latest date for future bookings for ",$P(SDC(1),"^",2)," is: " S Y=SDMAX D DTS^SDUTL W Y,!," If you enter a date here, it must be less than this date to further limit the",!," search" G LIM "RTN","SDM0",228,0) S %DT="EF",%DT(0)=-SDMAX D ^%DT K %DT G:Y<0!(Y0 (SDDMAX,SDMAX)=+Y "RTN","SDM0",229,0) G OVR^SDMULT0 "RTN","SDM2A") 0^5^B21850662^B21288152 "RTN","SDM2A",1,0) SDM2A ;ALB/OG - MAKE APPOINTMENT - overflow routine ;1/11/16 10:34am "RTN","SDM2A",2,0) ;;5.3;Scheduling;**446,528,567,594,611,645**;Aug 13 1993;Build 7 "RTN","SDM2A",3,0) ; "RTN","SDM2A",4,0) ; "RTN","SDM2A",5,0) WL(SC) ;Wait List Hook/teh patch 263 ;SD/327 passed 'SC' "RTN","SDM2A",6,0) N DA,DIE,DR,SBEG,SCSR,SDDIV,SDINST,SDPAR,SDWLDA,SDWLDFN,SDWLSCL "RTN","SDM2A",7,0) Q:$G(SC)'>0 "RTN","SDM2A",8,0) I '$D(^SC(SC)) Q "RTN","SDM2A",9,0) S SDINST="" "RTN","SDM2A",10,0) ;S SDINST=$$GET1^DIQ(44,SC_",",3,"I") ; get Inst BEFORE "RTN","SDM2A",11,0) S SDDIV=$$GET1^DIQ(44,SC_",",3.5,"I") S:SDDIV'="" SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") "RTN","SDM2A",12,0) I SDINST="" D Q ; sd/446 "RTN","SDM2A",13,0) .N DIR "RTN","SDM2A",14,0) .D MESS2^SDWL120(SC) "RTN","SDM2A",15,0) .W !,"No Institution/Division is associated with this Clinic." "RTN","SDM2A",16,0) .W !,"Unable to create a Wait List Entry. Abandoning request." "RTN","SDM2A",17,0) .W !!,"A message is being sent to the administrators mail group" "RTN","SDM2A",18,0) .W !,"alerting them to the situation." "RTN","SDM2A",19,0) .S DIR(0)="E" D ^DIR "RTN","SDM2A",20,0) .Q "RTN","SDM2A",21,0) S SDPAR=0 "RTN","SDM2A",22,0) ;create 409.32 entry "RTN","SDM2A",23,0) I $D(^SDWL(409.32,"B",SC)) S SDWLSCL=$O(^SDWL(409.32,"B",SC,"")) "RTN","SDM2A",24,0) E D "RTN","SDM2A",25,0) .N DA,DIC,X,DIE,DR "RTN","SDM2A",26,0) .S DIC(0)="LX",X=SC,DIC="^SDWL(409.32," D FILE^DICN "RTN","SDM2A",27,0) .S SDWLSCL=DA "RTN","SDM2A",28,0) .S DIE="^SDWL(409.32," "RTN","SDM2A",29,0) .S DR=".02////^S X=SDINST" D ^DIE "RTN","SDM2A",30,0) .S DR="1////^S X=DT" "RTN","SDM2A",31,0) .S DR=DR_";2////^S X=DUZ" "RTN","SDM2A",32,0) .D ^DIE S SDPAR=1 ; flag indicating clinic parameter entry "RTN","SDM2A",33,0) .; CREATE 409.3 with 120 flag "RTN","SDM2A",34,0) S DIC(0)="LX",(X,SDWLDFN)=DFN,DIC="^SDWL(409.3," D FILE^DICN "RTN","SDM2A",35,0) ; File just created so lock should never fail. "RTN","SDM2A",36,0) F L +^SDWL(409.3,DA):5 Q:$T W !,"Unable to acquire a lock on the Wait List file" Q "RTN","SDM2A",37,0) ; Update EWL variables. "RTN","SDM2A",38,0) S SDWLDA=DA D EN^SDWLE11 ; get enrollee both SDWLDA and SDWLDFN have to be defined "RTN","SDM2A",39,0) S DIE="^SDWL(409.3," "RTN","SDM2A",40,0) S DR="1////^S X=DT" "RTN","SDM2A",41,0) S DR=DR_";2////^S X=SDINST" "RTN","SDM2A",42,0) S DR=DR_";4////^S X=4" "RTN","SDM2A",43,0) S DR=DR_";8////^S X=SDWLSCL" "RTN","SDM2A",44,0) S DR=DR_";9////^S X=DUZ" "RTN","SDM2A",45,0) S DR=DR_";10////^S X=""A""" "RTN","SDM2A",46,0) S DR=DR_";11////^S X=2" ; by patient for this entry to avoid asking for provider "RTN","SDM2A",47,0) S DR=DR_";14////^S X="""_$S($P($G(^DPT(SDWLDFN,.3)),U,1)="Y":$P(^DPT(SDWLDFN,.3),U,2),1:"")_"""" "RTN","SDM2A",48,0) S DR=DR_";15////^S X="_$S($P($G(^DPT(SDWLDFN,.3)),U,1)="Y":1,1:0) "RTN","SDM2A",49,0) S DR=DR_";22////^S X=SDDATE" "RTN","SDM2A",50,0) S DR=DR_";23////^S X=""O""" "RTN","SDM2A",51,0) S DR=DR_";25////^S X="" > 120 days""" "RTN","SDM2A",52,0) S DR=DR_";36////^S X=1" "RTN","SDM2A",53,0) D ^DIE "RTN","SDM2A",54,0) L -^SDWL(409.3,DA) "RTN","SDM2A",55,0) S SDWLFLG=0 D MESS^SDWL120(SDWLDFN,SDWLDA,SDPAR) "RTN","SDM2A",56,0) Q "RTN","SDM2A",57,0) ; "RTN","SDM2A",58,0) WLCL120(SC,DESDT) ; Is there clinic availability within 120 days of desired date ; sd/446 "RTN","SDM2A",59,0) N SBEG,SD120 "RTN","SDM2A",60,0) Q:$$GET1^DIQ(44,SC,2502,"I")="Y" 1 ; Non-count clinic. Allow > 120 days. "RTN","SDM2A",61,0) S SD120=0,SBEG=DESDT-1 ;SD*567 added Go next line "RTN","SDM2A",62,0) F S SBEG=$O(^SC(SC,"ST",SBEG)) Q:SBEG="" G:'$D(^(1)) WL1 I $$HASAVSL(^SC(SC,"ST",SBEG,1)) D Q "RTN","SDM2A",63,0) .N X,DESDTH "RTN","SDM2A",64,0) .S X=SBEG D H^%DTC S SBEG=%H "RTN","SDM2A",65,0) .S X=DESDT D H^%DTC S DESDTH=%H "RTN","SDM2A",66,0) .S SD120=(SBEG-DESDTH>120) "RTN","SDM2A",67,0) .Q "RTN","SDM2A",68,0) Q 'SD120 "RTN","SDM2A",69,0) ; "RTN","SDM2A",70,0) WL1 ; SD*567 check for bad record and delete if applicable "RTN","SDM2A",71,0) I '$D(^SC(SC,"ST",SBEG,1)) I $D(^(9)) D DELETE "RTN","SDM2A",72,0) Q 'SD120 "RTN","SDM2A",73,0) ; "RTN","SDM2A",74,0) DELETE ; SD*567 delete bad record "RTN","SDM2A",75,0) S DA=SBEG,DA(1)=SC "RTN","SDM2A",76,0) S DIK="^SC("_DA(1)_",""ST""," "RTN","SDM2A",77,0) D ^DIK "RTN","SDM2A",78,0) K DA,DIK "RTN","SDM2A",79,0) Q "RTN","SDM2A",80,0) ; "RTN","SDM2A",81,0) WLCL120A(SDWLAPDT,SDDATE1,SC) ; "RTN","SDM2A",82,0) N %DT,DIR,X,X1,X2,Y,SDRET,SDWLDFN "RTN","SDM2A",83,0) Q:$$GET1^DIQ(44,SC,2502,"I")="Y" 1 ; Non-count clinic. Allow > 120 days. "RTN","SDM2A",84,0) S X=SDWLAPDT,%DT="TXF" D ^%DT "RTN","SDM2A",85,0) Q:Y=-1 1 "RTN","SDM2A",86,0) S X1=Y,X2=SDDATE1 D ^%DTC "RTN","SDM2A",87,0) I X'>120 Q 1 "RTN","SDM2A",88,0) ;SD*5.3*611 will not allow a prompt to create a wait list entry when clinic has an inactive date "RTN","SDM2A",89,0) ;in the SD WAIT LIST LOCATION (#409.3) file. "RTN","SDM2A",90,0) S SDWLDFN=$O(^SDWL(409.32,"B",+SC,0)) "RTN","SDM2A",91,0) I SDWLDFN'="",$P($G(^SDWL(409.32,SDWLDFN,0)),U,4)'="" Q 1 "RTN","SDM2A",92,0) S DIR(0)="Y",DIR("B")="YES" "RTN","SDM2A",93,0) ; SD*5.3*645 - replaced Desired Date with CID/Preferred Date when presented to the user "RTN","SDM2A",94,0) ;S DIR("A")="Add to EWL",DIR("A",1)="The date is more than 120 days beyond the Desired Date" "RTN","SDM2A",95,0) S DIR("A")="Add to EWL",DIR("A",1)="The date is more than 120 days beyond the CID/Preferred Date" "RTN","SDM2A",96,0) W ! D ^DIR "RTN","SDM2A",97,0) ;SD*5.3*594 allow appointment creation for appointments that have an appointment date "RTN","SDM2A",98,0) ;that is greater than 120 days from the desired date. "RTN","SDM2A",99,0) S SDRET=Y "RTN","SDM2A",100,0) I SDRET=1 D WL(SC) "RTN","SDM2A",101,0) I SDRET=0 Q 1 "RTN","SDM2A",102,0) Q 0 "RTN","SDM2A",103,0) ; "RTN","SDM2A",104,0) WLCLASK() ; No appointment availability warning. ; sd/446 "RTN","SDM2A",105,0) N DIR "RTN","SDM2A",106,0) S DIR(0)="Y" "RTN","SDM2A",107,0) ; SD*5.3*645 - replaced Desired Date with CID/Preferred Date when presented to the user "RTN","SDM2A",108,0) ;S DIR("A",1)="No appointments are available within 120 days of the Desired Date." "RTN","SDM2A",109,0) S DIR("A",1)="No appointments are available within 120 days of the CID/Preferred Date." "RTN","SDM2A",110,0) S DIR("A",2)="Do you want to place this patient on the Electronic Wait List" "RTN","SDM2A",111,0) ; SD*5.3*645 - replaced Desired Date with CID/Preferred Date when presented to the user "RTN","SDM2A",112,0) ;S DIR("A",3)="or change the desired date?" "RTN","SDM2A",113,0) S DIR("A",3)="or change the CID/Preferred Date?" "RTN","SDM2A",114,0) S DIR("A",4)="" "RTN","SDM2A",115,0) S DIR("A",5)="Enter ""Y"" to place on EWL, ""N"" to go back" "RTN","SDM2A",116,0) S DIR("A")="or ""^"" to return to the CLINIC: prompt. " "RTN","SDM2A",117,0) W ! D ^DIR "RTN","SDM2A",118,0) Q Y "RTN","SDM2A",119,0) ; "RTN","SDM2A",120,0) HASAVSL(SCSR) ; Has available slots ; sd/446 "RTN","SDM2A",121,0) ; Look at CLINIC PATTERN CURRENT AVAILABILITY string (44.005/1) "RTN","SDM2A",122,0) ; If there is 1-9,j-z within the [ ... ], there is availability for that day. "RTN","SDM2A",123,0) N DIC,F,SDOK,X,Y "RTN","SDM2A",124,0) ; Allow whatever if user has a key to overbook. "RTN","SDM2A",125,0) S DIC="^VA(200,"_DUZ_",51,",X="SDOB" D ^DIC Q:Y'=-1 1 "RTN","SDM2A",126,0) S X="SDMOB" D ^DIC Q:Y'=-1 1 "RTN","SDM2A",127,0) Q:SCSR'["[" 0 ; No slots. "RTN","SDM2A",128,0) S SCSR=$TR($E(SCSR,$F(SCSR,"[")-1,$L(SCSR))," |"),(SDOK,F)=0 "RTN","SDM2A",129,0) F S F=$F(SCSR,"[",F) Q:'F D Q:SDOK "RTN","SDM2A",130,0) .N I,SCSR0,SL "RTN","SDM2A",131,0) .S SCSR0=$E(SCSR,F,$F(SCSR,"]",F)-2) "RTN","SDM2A",132,0) .F I=1:1:$L(SCSR0) S SL=$E(SCSR0,I) I $A(SL)>105&($A(SL)<123)!SL S SDOK=1 Q ; If SL=1-9,j-z slots are available "RTN","SDM2A",133,0) .Q "RTN","SDM2A",134,0) Q SDOK "RTN","SDMM1") 0^6^B16255799^B15878644 "RTN","SDMM1",1,0) SDMM1 ;ALB/GRR - MULTIPLE BOOKINGS ;1/5/16 12:23pm "RTN","SDMM1",2,0) ;;5.3;Scheduling;**28,206,168,327,622,645**;Aug 13, 1993;Build 7 "RTN","SDMM1",3,0) MAKE S (SDX3,X,SD)=Y,SM=0 D DOW^SDM0 I $D(^DPT(DFN,"S",X)) S I=^(X,0) I $P(I,"^",2)'["C" W !,"PATIENT ALREADY HAS APPOINTMENT ON ",$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$E(X,4,5))," ",$E(X,6,7)," AT THAT TIME" Q "RTN","SDMM1",4,0) S SDX7=X D SDFT^SDMM S X=SDX7 I $P(SDX3,".")'1 S ^DPT(DFN,"S",SD,1)=$P($G(SD),".",1)_U_SDSRFU "RTN","SDMM1",21,0) E S ^DPT(DFN,"S",SD,1)=SDDATE_U_SDSRFU ; end changes for SD*5.3*645 "RTN","SDMM1",22,0) D XRDT(DFN,X) ;xref DATE APPT. MADE field "RTN","SDMM1",23,0) K:$D(^DPT("ASDCN",SC,X,DFN)) ^(DFN) K:$D(^DPT(DFN,"S",X,"R")) ^("R") "RTN","SDMM1",24,0) S SDRT="A",SDTTM=X,SDPL=SDY,SDSC=SC D RT^SDUTL "RTN","SDMM1",25,0) L W !,"APPOINTMENT MADE ON " S Y=X D DT^DIQ "RTN","SDMM1",26,0) ;check for open EWL entries and create TMP($J,"APPT";SD/327 "RTN","SDMM1",27,0) N SDEV,SD D EN^SDWLEVAL(DFN,.SDEV) S SD=X I SDEV D APPT^SDWLEVAL(DFN,SD,SC) "RTN","SDMM1",28,0) D EVT "RTN","SDMM1",29,0) Q "RTN","SDMM1",30,0) ; "RTN","SDMM1",31,0) XRDT(DFN,X) ;cross reference DATE APPT. MADE field "RTN","SDMM1",32,0) ;Input: DFN=patient ifn "RTN","SDMM1",33,0) ;Input: X=appointment date "RTN","SDMM1",34,0) N DIK,DA,DIV S DA=X,DA(1)=DFN "RTN","SDMM1",35,0) S DIK="^DPT(DA(1),""S"",",DIK(1)=20 D EN1^DIK "RTN","SDMM1",36,0) Q "RTN","SDMM1",37,0) ; "RTN","SDMM1",38,0) NOOB S SDMES="NO OPEN SLOTS ON " "RTN","SDMM1",39,0) WRTER W !,SDMES D DT W:SDNOT " AT THAT TIME" S SDNOT=0 Q "RTN","SDMM1",40,0) DT W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",$E(X,4,5))," ",$E(X,6,7) Q "RTN","SDMM1",41,0) DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR "RTN","SDMM1",42,0) ; "RTN","SDMM1",43,0) X L I SDZ=1 W !,*7,"CLINIC DOES NOT MEET THEN!!" S SDERRFT=1 Q "RTN","SDMM1",44,0) S SDMES="CLINIC DOES NOT MEET ON " G WRTER "RTN","SDMM1",45,0) ; "RTN","SDMM1",46,0) EVT ; -- separate tag if need to NEW vars "RTN","SDMM1",47,0) N D,SI,SC,SL,COLLAT D MAKE^SDAMEVT(DFN,SDTTM,SDSC,SDPL,0) "RTN","SDMM1",48,0) Q "RTN","SDMM1",49,0) ; "RTN","SDMM1",50,0) OB ; check for overbook keys "RTN","SDMM1",51,0) N %,D,I,S,ST "RTN","SDMM1",52,0) S SDNOT=1 "RTN","SDMM1",53,0) I '$D(^XUSEC("SDOB",DUZ)),'$D(^XUSEC("SDMOB",DUZ)) D NOOB G OBQ ; user has neither key "RTN","SDMM1",54,0) S I=$P(SD,".",1),(S,ST)=$P(SL,U,7) ; counter of OBs for day = ST "RTN","SDMM1",55,0) I ST F D=I-.01:0 S D=$O(^SC(SC,"S",D)) Q:$P(D,".",1)-I F %=0:0 S %=$O(^SC(SC,"S",D,1,%)) Q:'% I $P(^(%,0),"^",9)'["C",$D(^("OB")) S ST=ST-1 "RTN","SDMM1",56,0) I ST<1 D G OBQ "RTN","SDMM1",57,0) . I '$D(^XUSEC("SDMOB",DUZ)) W !,*7,"ONLY "_S_" OVERBOOK"_$E("S",S>1)_" ALLOWED PER DAY!!" D NOOB Q "RTN","SDMM1",58,0) . S MXOK=$$DIR("WILL EXCEED MAXIMUM ALLOWABLE OVERBOOKS FOR "_$$FMTE^XLFDT(Y)_", OK","YES") "RTN","SDMM1",59,0) . I 'MXOK S SM=9,SDNOT=0 Q "RTN","SDMM1",60,0) . I MXOK S S=^SC(SC,"ST",I,1),SM=9,MXOK="" "RTN","SDMM1",61,0) I '$D(^XUSEC("SDOB",DUZ)) D NOOB G OBQ "RTN","SDMM1",62,0) I '$$DIR($$FMTE^XLFDT(Y)_" WILL BE AN OVERBOOK, OK","NO") S SM=9,SDNOT=0 "RTN","SDMM1",63,0) OBQ Q "RTN","SDMM1",64,0) ; "RTN","SDMM1",65,0) DIR(TEXT,DEF) ; reader processor "RTN","SDMM1",66,0) ; Input: TEXT as text of read "RTN","SDMM1",67,0) ; DEF as default response (if any) "RTN","SDMM1",68,0) ; "RTN","SDMM1",69,0) N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y "RTN","SDMM1",70,0) S DIR(0)="Y",DIR("A")=TEXT "RTN","SDMM1",71,0) I $G(DEF)]"" S DIR("B")=DEF "RTN","SDMM1",72,0) D ^DIR "RTN","SDMM1",73,0) W:'Y ! "RTN","SDMM1",74,0) Q Y "RTN","SDWL120") 0^7^B7897103^B7543417 "RTN","SDWL120",1,0) SDWL120 ;IOFO BAY PINES/esw- EWL- 120 delay appt message ;1/11/16 10:32am "RTN","SDWL120",2,0) ;;5.3;scheduling;**446,645**;AUG 13, 1993;Build 7 "RTN","SDWL120",3,0) ; "RTN","SDWL120",4,0) MESS(DFN,SDWLDA,SDPR) ; "RTN","SDWL120",5,0) ; SDWLDA - EWL IEN to 409.3 "RTN","SDWL120",6,0) ; SDPR - flag indicating creation of 409.32 clinic entry "RTN","SDWL120",7,0) ; 0 - no entry "RTN","SDWL120",8,0) ; 1 - entry created "RTN","SDWL120",9,0) S ^TMP("SDWL120",$J,.01)="An open Wait List entry was created with a 120 days flag, indicating that it" "RTN","SDWL120",10,0) S ^TMP("SDWL120",$J,.02)="was not possible to schedule an appointment for the listed clinic within" "RTN","SDWL120",11,0) ; SD*5.3*645 - replaced desired date with CID/Preferred Date "RTN","SDWL120",12,0) ; S ^TMP("SDWL120",$J,.03)="120 days of the desired date." "RTN","SDWL120",13,0) S ^TMP("SDWL120",$J,.03)="120 days of the CID/Preferred Date." "RTN","SDWL120",14,0) S ^TMP("SDWL120",$J,.04)="" "RTN","SDWL120",15,0) N SDAPPT,Y "RTN","SDWL120",16,0) S ^TMP("SDWL120",$J,.05)="An EWL Entry was created for the following patient," "RTN","SDWL120",17,0) S ^TMP("SDWL120",$J,.06)="" "RTN","SDWL120",18,0) S ^TMP("SDWL120",$J,.07)=$$FORM^SDFORM("PATIENT NAME",23,"SSN",12,"EWL",35) "RTN","SDWL120",19,0) S ^TMP("SDWL120",$J,.08)="--------------------------------------------------------------------------" "RTN","SDWL120",20,0) S ^TMP("SDWL120",$J,.09)=$$FORM^SDFORM($E($$GET1^DIQ(2,DFN_",",.01,"I"),1,25),23,$$GET1^DIQ(2,DFN_",",.09,"I"),12,$$GET1^DIQ(409.3,SDWLDA_",",8),35) "RTN","SDWL120",21,0) S ^TMP("SDWL120",$J,.1)="" "RTN","SDWL120",22,0) I SDPR S ^TMP("SDWL120",$J,.11)="SD WL CLINIC LOCATION parameter entry created." "RTN","SDWL120",23,0) N XMSUB,XMY,XMTEXT,XMDUZ "RTN","SDWL120",24,0) S XMSUB="EWL opened entry with a 120 days flag" "RTN","SDWL120",25,0) S XMY("G.SD EWL BACKGROUND UPDATE")="" "RTN","SDWL120",26,0) S XMTEXT="^TMP(""SDWL120"",$J," "RTN","SDWL120",27,0) S XMDUZ="POSTMASTER" "RTN","SDWL120",28,0) D ^XMD K ^TMP("SDWL120",$J) "RTN","SDWL120",29,0) Q "RTN","SDWL120",30,0) ; "RTN","SDWL120",31,0) MESS2(SC) ; "RTN","SDWL120",32,0) ; SC - pointer to file 44 "RTN","SDWL120",33,0) S ^TMP("SDWL120",$J,.01)="An attempt has been made to create an EWL Entry after the lack of" "RTN","SDWL120",34,0) S ^TMP("SDWL120",$J,.02)="any availability on the clinic," "RTN","SDWL120",35,0) S ^TMP("SDWL120",$J,.03)=$$GET1^DIQ(44,SC,.01) "RTN","SDWL120",36,0) ; SD*5.3*645 - replaced desired date with CID/Preferred Date "RTN","SDWL120",37,0) ; S ^TMP("SDWL120",$J,.04)="within 120 days of a patient's desired date." "RTN","SDWL120",38,0) S ^TMP("SDWL120",$J,.04)="within 120 days of a patient's CID/Preferred Date." "RTN","SDWL120",39,0) S ^TMP("SDWL120",$J,.05)="" "RTN","SDWL120",40,0) S ^TMP("SDWL120",$J,.06)="The clinic has no linked Institution or Division which are required" "RTN","SDWL120",41,0) S ^TMP("SDWL120",$J,.07)="to create the association with a Wait List." "RTN","SDWL120",42,0) N XMSUB,XMY,XMTEXT,XMDUZ "RTN","SDWL120",43,0) S XMSUB="EWL Location entry could not be created" "RTN","SDWL120",44,0) S XMY("G.SD EWL BACKGROUND UPDATE")="" "RTN","SDWL120",45,0) S XMTEXT="^TMP(""SDWL120"",$J," "RTN","SDWL120",46,0) S XMDUZ="POSTMASTER" "RTN","SDWL120",47,0) D ^XMD "RTN","SDWL120",48,0) K ^TMP("SDWL120",$J) "RTN","SDWL120",49,0) Q "RTN","SDWLE110") 0^8^B23562010^B24136390 "RTN","SDWLE110",1,0) SDWLE110 ;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT ;1/11/16 10:32am "RTN","SDWLE110",2,0) ;;5.3;scheduling;**263,273,424,454,554,645**;AUG 13 1993;Build 7 "RTN","SDWLE110",3,0) ; "RTN","SDWLE110",4,0) ; "RTN","SDWLE110",5,0) ;****************************************************************** "RTN","SDWLE110",6,0) ; CHANGE LOG "RTN","SDWLE110",7,0) ; "RTN","SDWLE110",8,0) ; DATE PATCH DESCRIPTION "RTN","SDWLE110",9,0) ; ---- ----- ----------- "RTN","SDWLE110",10,0) ; 11/27/02 SD*5.3*273 Add "/", line SA1+11,+13,FA2+13 "RTN","SDWLE110",11,0) ; "RTN","SDWLE110",12,0) ; "RTN","SDWLE110",13,0) EN K DIR "RTN","SDWLE110",14,0) I $D(^SDWL(409.3,SDWLDA,0)) S DIR("B")=$$EXTERNAL^DILFD(409.3,10,,$P(^(0),U,11)) "RTN","SDWLE110",15,0) I DIR("B")="" K DIR("B") "RTN","SDWLE110",16,0) S DIR(0)="SO^1:Future Date;2:ASAP" "RTN","SDWLE110",17,0) S DIR("L",1)="Priority",DIR("L",2)="" "RTN","SDWLE110",18,0) S DIR("L",3)="1. Future Date",DIR("L")="2. ASAP" "RTN","SDWLE110",19,0) D ^DIR I X["^" S DUOUT=1 Q ;-'^' here will remove patient from wait list "RTN","SDWLE110",20,0) I X="@" W *7," ??" G EN "RTN","SDWLE110",21,0) I X="" W *7,"Required or '^' to quit." G EN "RTN","SDWLE110",22,0) I $D(DTOUT) S DUOUT=1 Q "RTN","SDWLE110",23,0) S X=$E(X,1) "RTN","SDWLE110",24,0) S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCEDFGHIJKLMNOPQRSTUVWXYZ") "RTN","SDWLE110",25,0) S SDWLPRIE=$S(X["A":"A",X["F":"F",X[1:"F",X[2:"A",1:"F") "RTN","SDWLE110",26,0) S DIE="^SDWL(409.3,",DA=SDWLDA,DR="10////^S X=SDWLPRIE" D ^DIE "RTN","SDWLE110",27,0) ; "RTN","SDWLE110",28,0) ;If priority is ASAP ask requesting provider "RTN","SDWLE110",29,0) ; "RTN","SDWLE110",30,0) I SDWLPRIE="A" S Y=DT D DD^%DT W " ",Y D SA,DUP G END:$D(DUOUT) Q "RTN","SDWLE110",31,0) I SDWLPRIE="F" D FA G END:$D(DUOUT) Q ;to enter future date "RTN","SDWLE110",32,0) Q "RTN","SDWLE110",33,0) ; "RTN","SDWLE110",34,0) SA K DIR,DR,DIE S SDWLERR=0,SDWLX=$S($D(SDWLPROV):$$EXTERNAL^DILFD(409.3,12,,SDWLPROV),1:"") "RTN","SDWLE110",35,0) I $D(SDWLPROV),SDWLPROV,SDWLX'="" S DIR("B")=SDWLX "RTN","SDWLE110",36,0) I $D(^SDWL(409.3,SDWLDA,0)) S DIR("B")=$$EXTERNAL^DILFD(409.3,11,,$P(^(0),U,12)) "RTN","SDWLE110",37,0) I DIR("B")="" K DIR("B") "RTN","SDWLE110",38,0) K %DT,DR S DIR(0)="SO^1:Provider;2:Patient" "RTN","SDWLE110",39,0) S DIR("L",1)="Request By",DIR("L",2)="" "RTN","SDWLE110",40,0) S DIR("L",3)="1. Provider",DIR("L")="2. Patient" "RTN","SDWLE110",41,0) D ^DIR I X["^" S DUOUT=1,DIR("A")="ASAP" Q "RTN","SDWLE110",42,0) S X=Y "RTN","SDWLE110",43,0) I $D(DTOUT) S DUOUT=1,DIR("A")="ASAP" Q "RTN","SDWLE110",44,0) S SDWLRBE=$S(X=1:1,X["PR":1,X["pr":1,X["Pr":1,X=2:2,X["PA":2,X["pa":2,X["Pa":2,1:0) I 'SDWLRBE W *7," ??" G SA "RTN","SDWLE110",45,0) S DR="11////^S X=SDWLRBE",DA=SDWLDA,DIE="^SDWL(409.3," D ^DIE "RTN","SDWLE110",46,0) ; "RTN","SDWLE110",47,0) SA1 I SDWLRBE=1 D "RTN","SDWLE110",48,0) .S DIC("S")="I $$SCREEN^SDUTL2(Y,DT)" "RTN","SDWLE110",49,0) .S SDWLX=$S($D(SDWLPROV):$$EXTERNAL^DILFD(409.3,12,,SDWLPROV),1:"") I SDWLX'="" S DIC("B")=SDWLPROV "RTN","SDWLE110",50,0) .I $D(^SDWL(409.3,SDWLDA,0)) S DIR("B")=$$EXTERNAL^DILFD(409.3,11,,$P(^(0),U,12)) "RTN","SDWLE110",51,0) .S SDWLERR=0,DIC(0)="AEQ",DIC=200,DIC("A")="Provider Requesting Appointment: " D ^DIC "RTN","SDWLE110",52,0) .I X["^" S DUOUT=1 Q "RTN","SDWLE110",53,0) .I Y<1 S SDWLERR=1 Q "RTN","SDWLE110",54,0) .I $D(DUOUT) Q "RTN","SDWLE110",55,0) .I $D(DTOUT) S DUOUT=1 Q "RTN","SDWLE110",56,0) .K DIC,DIC("S"),DIC("A"),DIC(0),DIC("B") "RTN","SDWLE110",57,0) .S SDWLPROV=+Y,SDWLPRON=$P(Y,U,2),DIE="^SDWL(409.3,",DA=SDWLDA "RTN","SDWLE110",58,0) .S DR="12////^S X=SDWLPROV" D ^DIE S SDWLPRVE=SDWLPROV "RTN","SDWLE110",59,0) I SDWLERR W *7," Required" G SA1 "RTN","SDWLE110",60,0) S DR="11////^S X=SDWLRBE" D ^DIE "RTN","SDWLE110",61,0) S DR="22///TODAY" D ^DIE K DIE,DR,DIC,DIR,SDWLPRVE,SDWLPROV,SDWLPRON "RTN","SDWLE110",62,0) Q "RTN","SDWLE110",63,0) ; "RTN","SDWLE110",64,0) ;If Priority is 'FUTURE' ask Desired Date of Appointment and Requesting by Provider or Patient "RTN","SDWLE110",65,0) ; "RTN","SDWLE110",66,0) FA S SDWLERR=0 K DIR,DUOUT,DR,DIE I $D(SDWLDAPE) S Y=SDWLDAPE D DD^%DT S DIR("B")=Y "RTN","SDWLE110",67,0) I $D(^SDWL(409.3,SDWLDA,0)),$P(^(0),U,16) S %DT("B")=$$EXTERNAL^DILFD(409.3,22,,$P(^(0),U,16)) ;SD*5.3*424 "RTN","SDWLE110",68,0) ; SD*5.3*645 - replaced Desired Date with CID/Preferred Date when presented to the user "RTN","SDWLE110",69,0) ;S %DT="AEF",%DT("A")="Desired Date of Appointment: " D ^%DT ; Added "F" to set to a future date - PATCH SD*5.3*554 "RTN","SDWLE110",70,0) S %DT="AEF",%DT("A")="CID/Preferred Date of Appointment: " D ^%DT "RTN","SDWLE110",71,0) I $D(DTOUT)!(X="^") G EN "RTN","SDWLE110",72,0) I X="" W *7,!!,"This is a required response. Enter '^' to exit.",! G EN ;SD*5.3*454 "RTN","SDWLE110",73,0) S SDWLDAPE=Y,DR="22////^S X=SDWLDAPE",DIE="^SDWL(409.3,",DA=SDWLDA D ^DIE "RTN","SDWLE110",74,0) K SDWLDAPE,Y,DA,DIE,%DT,%DT(0),%DT("A"),%DT("B") "RTN","SDWLE110",75,0) ; "RTN","SDWLE110",76,0) FA1 K DIR,%DT,DR S DIR(0)="SO^1:Provider;2:Patient" "RTN","SDWLE110",77,0) S SDWLX=$S($D(SDWLPROV):$$EXTERNAL^DILFD(409.3,12,,SDWLPROV),1:"") I SDWLX'="" S DIR("B")=SDWLPROV "RTN","SDWLE110",78,0) I $D(^SDWL(409.3,SDWLDA,0)) S DIR("B")=$$EXTERNAL^DILFD(409.3,11,,$P(^(0),U,12)) "RTN","SDWLE110",79,0) I DIR("B")="" K DIR("B") "RTN","SDWLE110",80,0) S DIR("L",1)="Request By",DIR("L",2)="" "RTN","SDWLE110",81,0) S DIR("L",3)="1. Provider",DIR("L")="2. Patient" "RTN","SDWLE110",82,0) D ^DIR I X["^" S DIR("B")=$S($D(SDWLDAPE):SDWLDAPE,1:"") G FA "RTN","SDWLE110",83,0) S X=Y "RTN","SDWLE110",84,0) I $D(DTOUT) S DUOUT=1 S DIR("B")=SDWLDAPE G FA "RTN","SDWLE110",85,0) S SDWLRBE=$S(X=1:1,X["PR":1,X["pr":1,X["Pr":1,X=2:2,X["PA":2,X["pa":2,X["Pa":2,1:0) I 'SDWLRBE W *7," ??" G FA1 "RTN","SDWLE110",86,0) S DR="11////^S X=SDWLRBE",DA=SDWLDA,DIE="^SDWL(409.3," D ^DIE "RTN","SDWLE110",87,0) ; "RTN","SDWLE110",88,0) FA2 I SDWLRBE=1 D "RTN","SDWLE110",89,0) .; "RTN","SDWLE110",90,0) .;if provider is selected look-up valid provider from new person (File 200) "RTN","SDWLE110",91,0) .; "RTN","SDWLE110",92,0) .S DIC("S")="I $$SCREEN^SDUTL2(Y,DT)" "RTN","SDWLE110",93,0) .S SDWLX=$S($D(SDWLPROV):$$EXTERNAL^DILFD(409.3,12,,SDWLPROV),1:""),DIC("B")=$S($D(SDWLPROV):SDWLX,1:"") "RTN","SDWLE110",94,0) .S SDWLERR=0,DIC(0)="AEQ",DIC=200,DIC("A")="Provider Requesting Appointment: " D ^DIC "RTN","SDWLE110",95,0) .I X["^" S DUOUT=1 Q "RTN","SDWLE110",96,0) .I Y<1 S SDWLERR=1 Q "RTN","SDWLE110",97,0) .I $D(DTOUT) S DUOUT=1 Q "RTN","SDWLE110",98,0) .Q:$D(DUOUT) D "RTN","SDWLE110",99,0) ..K DIC,DIC("S"),DIC("A"),DIC(0),DIC("B") "RTN","SDWLE110",100,0) ..S SDWLPROV=+Y,SDWLPRON=$P(Y,U,2),DIE="^SDWL(409.3,",DA=SDWLDA "RTN","SDWLE110",101,0) ..S DR="12////^S X=SDWLPROV" D ^DIE S SDWLPRVE=SDWLPROV K DIE "RTN","SDWLE110",102,0) I SDWLERR W *7," Required" G FA2 "RTN","SDWLE110",103,0) END K DIC,DIE,DIR I $D(DUOUT) S DIR("B")=$S(SDWLPRIE="F":"Future",1:"ASAP") "RTN","SDWLE110",104,0) K SDWLPRVE,SDWLPROV,SDWLPRON "RTN","SDWLE110",105,0) Q "RTN","SDWLE110",106,0) ; "RTN","SDWLE110",107,0) DUP ; "RTN","SDWLE110",108,0) Q "RTN","SDWLE7") 0^14^B14943839^B15146200 "RTN","SDWLE7",1,0) SDWLE7 ;IOFO BAY PINES/OG - WAITING LIST-ENTER/EDIT - MOVE EWL ENTRY ;1/11/16 10:31am "RTN","SDWLE7",2,0) ;;5.3;scheduling;**446,645**;AUG 13 1993;Build 7 "RTN","SDWLE7",3,0) ; "RTN","SDWLE7",4,0) ; ****************************************************************** "RTN","SDWLE7",5,0) ; CHANGE LOG "RTN","SDWLE7",6,0) ; "RTN","SDWLE7",7,0) ; DATE PATCH DESCRIPTION "RTN","SDWLE7",8,0) ; ---- ----- ----------- "RTN","SDWLE7",9,0) ; "RTN","SDWLE7",10,0) EN() ; "RTN","SDWLE7",11,0) N SDWLERR,SDWLCM,SDWLIN1,SDWLOPT,SDWLSC1,SDWLSC1X "RTN","SDWLE7",12,0) S (SDWLERR,SDWLOPT)=1,SDWLCM="" "RTN","SDWLE7",13,0) F D @("P"_SDWLOPT) Q:'SDWLOPT "RTN","SDWLE7",14,0) Q SDWLERR "RTN","SDWLE7",15,0) ; "RTN","SDWLE7",16,0) P1 ; Institution "RTN","SDWLE7",17,0) S DIR(0)="PAO^DIC(4,:EMNZ" "RTN","SDWLE7",18,0) S DIR("A")="Select Institution: " "RTN","SDWLE7",19,0) S DIR("B")=$$GET1^DIQ(4,SDWLIN,.01) "RTN","SDWLE7",20,0) S DIR("S")="I $E(+Y,1,3)=$E(SDWLIN,1,3)" "RTN","SDWLE7",21,0) D ^DIR "RTN","SDWLE7",22,0) I Y<1 S SDWLOPT=0 Q "RTN","SDWLE7",23,0) S SDWLIN1=+Y,SDWLOPT=2 "RTN","SDWLE7",24,0) Q "RTN","SDWLE7",25,0) P2 ; Clinic "RTN","SDWLE7",26,0) N DIR,Y,SDWLI,SDWLSTOP,SDWLSTP1,TMP "RTN","SDWLE7",27,0) S DIR(0)="PAO^SDWL(409.32,:EMNZ",DIR("A")="Select Clinic: " "RTN","SDWLE7",28,0) S DIR("S")="I +Y'=SDWLSC,$P(^SC($$GET1^DIQ(409.32,+Y,.01,""I""),0),U,4)=SDWLIN1" "RTN","SDWLE7",29,0) D ^DIR "RTN","SDWLE7",30,0) I Y="^" S SDWLOPT=0 Q "RTN","SDWLE7",31,0) I Y<1 S SDWLOPT=1 Q "RTN","SDWLE7",32,0) S SDWLSCL=+Y,SDWLSC1X=$$GET1^DIQ(409.32,SDWLSCL,.01) "RTN","SDWLE7",33,0) S SDWLSTOP=$$GET1^DIQ(44,$$GET1^DIQ(409.32,SDWLSC,.01,"I"),8,"I") "RTN","SDWLE7",34,0) S SDWLSTP1=$$GET1^DIQ(44,$$GET1^DIQ(409.32,SDWLSCL,.01,"I"),8,"I") "RTN","SDWLE7",35,0) I SDWLSTOP=SDWLSTP1 S SDWLOPT=3 Q "RTN","SDWLE7",36,0) K DIR "RTN","SDWLE7",37,0) S DIR(0)="Y" "RTN","SDWLE7",38,0) S TMP(0)=1,TMP(1,0)=$$GET1^DIQ(409.32,SDWLSC,.01)_" and "_SDWLSC1X_" have different stop codes." "RTN","SDWLE7",39,0) D COL80^SDWLIFT(.TMP) F SDWLI=1:1:TMP(0) S DIR("A",SDWLI)=TMP(SDWLI,0) "RTN","SDWLE7",40,0) S DIR("A")="Do you want to proceed?" "RTN","SDWLE7",41,0) S DIR("B")="NO" D ^DIR "RTN","SDWLE7",42,0) S SDWLOPT=Y*3 ; +Y=0: SDWLOPT=0; Y=1: SDWLOPT=3 "RTN","SDWLE7",43,0) Q "RTN","SDWLE7",44,0) ; "RTN","SDWLE7",45,0) P3 ; Comment "RTN","SDWLE7",46,0) D P4^SDWLE6 "RTN","SDWLE7",47,0) Q "RTN","SDWLE7",48,0) ; "RTN","SDWLE7",49,0) P4 ; Display data and confirm. "RTN","SDWLE7",50,0) N DIR,SDWLTMP,SDWLORDT,SDWLSCPG,SDWLSCPR,SDWLDDT,SDWLEEST,Y "RTN","SDWLE7",51,0) D GETS^DIQ(409.3,SDWLDA_",","1;14;15;22;27","I","SDWLTMP") "RTN","SDWLE7",52,0) S SDWLORDT=SDWLTMP(409.3,SDWLDA_",",1,"I") "RTN","SDWLE7",53,0) S SDWLSCPG=SDWLTMP(409.3,SDWLDA_",",14,"I") "RTN","SDWLE7",54,0) S SDWLSCPR=SDWLTMP(409.3,SDWLDA_",",15,"I") "RTN","SDWLE7",55,0) S SDWLDDT=SDWLTMP(409.3,SDWLDA_",",22,"I") "RTN","SDWLE7",56,0) S SDWLEEST=SDWLTMP(409.3,SDWLDA_",",27,"I") "RTN","SDWLE7",57,0) S DIR(0)="Y" "RTN","SDWLE7",58,0) S DIR("A",1)="The following EWL entry will be created" "RTN","SDWLE7",59,0) S Y=SDWLORDT D DD^%DT "RTN","SDWLE7",60,0) S DIR("A",2)="Originating Date: "_Y "RTN","SDWLE7",61,0) S DIR("A",3)="Institution: "_$$GET1^DIQ(4,SDWLIN1,.01) "RTN","SDWLE7",62,0) S DIR("A",4)="Wait List Type: SPECIFIC CLINIC" "RTN","SDWLE7",63,0) S DIR("A",5)="Clinic: "_SDWLSC1X "RTN","SDWLE7",64,0) S Y=SDWLDDT D DD^%DT "RTN","SDWLE7",65,0) ; SD*5.3*645 - replaced Desired Date with CID/Preferred date "RTN","SDWLE7",66,0) ;S DIR("A",6)="Desired Date of Appointment: "_Y "RTN","SDWLE7",67,0) S DIR("A",6)="CID/Preferred Date of Appointment: "_Y "RTN","SDWLE7",68,0) S DIR("A",7)="Comments: "_SDWLCM "RTN","SDWLE7",69,0) S DIR("A")="Continue?" "RTN","SDWLE7",70,0) S DIR("B")="YES" "RTN","SDWLE7",71,0) D ^DIR "RTN","SDWLE7",72,0) S SDWLOPT=0 "RTN","SDWLE7",73,0) Q:'Y "RTN","SDWLE7",74,0) I '$$UPDATE(SDWLDFN,SDWLORDT,SDWLIN,SDWLSCL,SDWLSCPG,SDWLSCPR,SDWLDDT,SDWLCM,SDWLEEST,SDWLDA) S SDWLOPT=3 "RTN","SDWLE7",75,0) Q "RTN","SDWLE7",76,0) UPDATE(SDWLDFN,SDWLORDT,SDWLIN,SDWLSCL,SDWLSCPG,SDWLSCPR,SDWLDDT,SDWLCM,SDWLEEST,SDWLDA) ; Create new EWL entry "RTN","SDWLE7",77,0) N DA,DIC,DIE,DR,X "RTN","SDWLE7",78,0) S DIC(0)="LX",X=SDWLDFN,DIC="^SDWL(409.3," D FILE^DICN "RTN","SDWLE7",79,0) L +^SDWL(409.3,DA):1 ; This file has just been created. Is it neurotic to code for the possibility of a lock from elsewhere? "RTN","SDWLE7",80,0) I '$T W !,"Unable to acquire a lock on the Wait List file" Q 0 "RTN","SDWLE7",81,0) S DIE=DIC "RTN","SDWLE7",82,0) S DR="1////^S X=SDWLORDT" "RTN","SDWLE7",83,0) S DR=DR_";2////^S X=SDWLIN" "RTN","SDWLE7",84,0) S DR=DR_";4////^S X=4" "RTN","SDWLE7",85,0) S DR=DR_";8////^S X=SDWLSCL" "RTN","SDWLE7",86,0) S DR=DR_";9////^S X=DUZ" "RTN","SDWLE7",87,0) S DR=DR_";14////^S X=SDWLSCPG" "RTN","SDWLE7",88,0) S DR=DR_";15////^S X=SDWLSCPR" "RTN","SDWLE7",89,0) S DR=DR_";22////^S X=SDWLDDT" "RTN","SDWLE7",90,0) S DR=DR_";23////^S X=""O""" "RTN","SDWLE7",91,0) S DR=DR_";25////^S X=SDWLCM" "RTN","SDWLE7",92,0) S DR=DR_";27////^S X=SDWLEEST" "RTN","SDWLE7",93,0) S DR=DR_";37////^S X=SDWLDA" "RTN","SDWLE7",94,0) D ^DIE "RTN","SDWLE7",95,0) L -^SDWL(409.3,DA) "RTN","SDWLE7",96,0) S SDWLERR=0 "RTN","SDWLE7",97,0) Q 1 "RTN","SDWLI") 0^18^B79675388^B76987504 "RTN","SDWLI",1,0) SDWLI ;BPOI/TEH - DISPLAY PENDING APPOINTMENTS ;1/11/16 10:31am "RTN","SDWLI",2,0) ;;5.3;scheduling;**263,327,394,446,524,505,611,645**;08/13/93;Build 7 "RTN","SDWLI",3,0) ; "RTN","SDWLI",4,0) ; "RTN","SDWLI",5,0) ;****************************************************************** "RTN","SDWLI",6,0) ; CHANGE LOG "RTN","SDWLI",7,0) ; "RTN","SDWLI",8,0) ; DATE PATCH DESCRIPTION "RTN","SDWLI",9,0) ; ---- ----- ----------- "RTN","SDWLI",10,0) ; 04/22/2005 SD*5.3*327 DISPLAY APPOINTMENT INFORMATION "RTN","SDWLI",11,0) ; 04/22/2005 SD*5.3*327 UNDEFINED ERROR HD+1 "RTN","SDWLI",12,0) ; 08/07/2006 SD*5.3*446 proceed only when DFN defined "RTN","SDWLI",13,0) ; 04/14/2006 SD*5.3*446 INTER-FACILITY TRANSFER "RTN","SDWLI",14,0) ; 01/14/2014 SD*5.3*611 Removed line "RTN","SDWLI",15,0) ; 01/14/2014 SD*5.3*611 Changed DIC lookup to use PATIENT (#2) file "RTN","SDWLI",16,0) ; "RTN","SDWLI",17,0) ; "RTN","SDWLI",18,0) ; Reference/ICR "RTN","SDWLI",19,0) ; PATIENT FILE/10035 "RTN","SDWLI",20,0) ; "RTN","SDWLI",21,0) ; "RTN","SDWLI",22,0) EN ;NEW AND INITIALIZE VARIABLES "RTN","SDWLI",23,0) S SDWLERR=0 N %DT,DD "RTN","SDWLI",24,0) I $D(SDWLLIST),SDWLLIST D Q:SDWLERR "RTN","SDWLI",25,0) .I '$G(DFN) S SDWLERR=1 Q "RTN","SDWLI",26,0) .I $D(DFN),DFN'="",'$D(^SDWL(409.3,"B",DFN)) D HD W *7,!,"This Patient has NO entries on the Electronic Wait List." S DIR(0)="E" D ^DIR S DUOUT=1 Q "RTN","SDWLI",27,0) I $D(DUOUT) G END "RTN","SDWLI",28,0) I 'SDWLERR,$D(SDWLLIST),SDWLLIST D 1^VADPT,DEM^VADPT S SDWLDFN=DFN D HD,SEL G END:$D(DUOUT) K DIR,DIC,DR,DIE,VADM S (SDWLBDT,SDWLEDT)="" K ^TMP("SDWLI",$J) G EN1 "RTN","SDWLI",29,0) K DIR,DIC,DR,DIE,VADM "RTN","SDWLI",30,0) S (SDWLBDT,SDWLEDT)="" K ^TMP("SDWLI",$J) "RTN","SDWLI",31,0) ; "RTN","SDWLI",32,0) ;OPTION HEADER "RTN","SDWLI",33,0) ; "RTN","SDWLI",34,0) D HD "RTN","SDWLI",35,0) ; "RTN","SDWLI",36,0) ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0). "RTN","SDWLI",37,0) ; "RTN","SDWLI",38,0) D SEL G EN:$D(DUOUT) "RTN","SDWLI",39,0) D PAT Q:'$D(SDWLDFN) "RTN","SDWLI",40,0) G END:SDWLDFN<0,END:SDWLDFN="" "RTN","SDWLI",41,0) Q:$D(DUOUT) "RTN","SDWLI",42,0) EN1 K DIR,DIC,DR,DIE,SDWLDRG "RTN","SDWLI",43,0) D GETFILE "RTN","SDWLI",44,0) D DISP G EN:'$D(DUOUT) "RTN","SDWLI",45,0) D END "RTN","SDWLI",46,0) Q "RTN","SDWLI",47,0) PAT ;PATIENT LOOK-UP "RTN","SDWLI",48,0) ;PATCH SD*5.3*524 - SET DIC("S") FOR SCREEN OF OPEN/CLOSED ENTRIES "RTN","SDWLI",49,0) K DIC,DIC("S") "RTN","SDWLI",50,0) ;SD*5.3*611 removed line "RTN","SDWLI",51,0) ;I $D(SDWLY),SDWLY S DIC("S")="I $P(^SDWL(409.3,+Y,0),U,17)=""O""" "RTN","SDWLI",52,0) ;changed DIC lookup to the PATIENT (#2) file. "RTN","SDWLI",53,0) S DIC(0)="EMNQA",DIC=2 D ^DIC S (SDWLDFN,DFN)=+Y "RTN","SDWLI",54,0) G PATEND:SDWLDFN="" "RTN","SDWLI",55,0) Q:Y<0 "RTN","SDWLI",56,0) Q:$D(DUOUT) "RTN","SDWLI",57,0) D 1^VADPT "RTN","SDWLI",58,0) PATEND Q "RTN","SDWLI",59,0) ; "RTN","SDWLI",60,0) ;PROMPT FOR DISPLAY 'OPEN' WAITING LIST ONLY OR PROMPT FOR BEGINNING AND ENDING DATES "RTN","SDWLI",61,0) ; "RTN","SDWLI",62,0) SEL K SDWLDRG S DIR(0)="Y" S DIR("A")="Do You Want to View Only 'OPEN' Wait Lists",DIR("B")="YES" "RTN","SDWLI",63,0) S DIR("?")="'Yes' for 'Open' and these Patient Record have not been dispositioned and 'No' for all Records." "RTN","SDWLI",64,0) W ! D ^DIR S SDWLY=Y W ! "RTN","SDWLI",65,0) I X["^" S DUOUT=1 Q "RTN","SDWLI",66,0) I SDWLY=0 D SEL1 "RTN","SDWLI",67,0) Q "RTN","SDWLI",68,0) SEL1 K DIR,%DT(0) S SDWLDISC="",%DT="AE",%DT("A")="Start with Date Entered: " D ^%DT G SEL:Y<1 S SDWLBDT=Y "RTN","SDWLI",69,0) S %DT(0)=SDWLBDT,%DT("A")="End with Date Entered: " D ^%DT G SEL1:Y<1 S SDWLEDT=Y,SDWLDRG="" K %DT(0),%DT("A") "RTN","SDWLI",70,0) Q "RTN","SDWLI",71,0) ; "RTN","SDWLI",72,0) GETFILE ;GET DATA - OPTIONAL DATE RANGE IF SDWLDBT AND SDWLEDT VALID DATE RANGE "RTN","SDWLI",73,0) ; "RTN","SDWLI",74,0) K ^TMP("SDWLI",$J),SDWLDISX S SDWLDA=0,SDWLCNT=0 F S SDWLDA=$O(^SDWL(409.3,"B",SDWLDFN,SDWLDA)) Q:SDWLDA="" D "RTN","SDWLI",75,0) .S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0)) I '$D(SDWLDRG),SDWLY,$P(SDWLDATA,U,17)["C" Q "RTN","SDWLI",76,0) .I '$P(SDWLDATA,U,3) Q "RTN","SDWLI",77,0) .N SDWLAPP S SDWLAPP="" I $D(^SDWL(409.3,SDWLDA,"SDAPT")) S SDWLAPP=^("SDAPT") D ;app data "RTN","SDWLI",78,0) ..S SDWLAPP=SDWLAPP_"~"_$P(SDWLDATA,U,23) "RTN","SDWLI",79,0) .N SDOP,SDOP1 S SDOP="" I $D(^SDWL(409.3,SDWLDA,1)) S SDOP=^(1),SDOP1=$$GET1^DIQ(409.3,SDWLDA_",",29),$P(SDOP,U)=SDOP1 "RTN","SDWLI",80,0) .I $D(^SDWL(409.3,SDWLDA,"DIS")) D "RTN","SDWLI",81,0) ..S SDWLDISX=$G(^SDWL(409.3,SDWLDA,"DIS")),SDWLDIS=$P(SDWLDISX,U,3),SDWLDDUZ=$P(SDWLDISX,U,2) "RTN","SDWLI",82,0) ..S SDWLDDT=$P(^SDWL(409.3,SDWLDA,"DIS"),U,1) "RTN","SDWLI",83,0) ..S SDWLDIDT="" I SDWLDDT'="" S SDWLDIDT=$E(SDWLDDT,4,5)_"/"_$E(SDWLDDT,6,7)_"/"_$E(SDWLDDT,2,3) "RTN","SDWLI",84,0) .I $D(^SDWL(409.3,SDWLDA,"DNR")) D "RTN","SDWLI",85,0) ..S SDREM=$G(^SDWL(409.3,SDWLDA,"DNR")) S SDREMD=$P(SDWLDATA,U,14),SDREMU=$P(SDWLDATA,U,15) "RTN","SDWLI",86,0) ..S SDREMDD="" I SDREMD'="" S SDREMDD=$E(SDREMD,4,5)_"/"_$E(SDREMD,6,7)_"/"_$E(SDREMD,2,3) "RTN","SDWLI",87,0) ..S SDREMR=$$GET1^DIQ(409.3,SDWLDA_",",18),SDREMRC=$$GET1^DIQ(409.3,SDWLDA_",",18.1,"I") "RTN","SDWLI",88,0) .S SDWLST=$P(SDWLDATA,U,6),SDWLSP=$P(SDWLDATA,U,7),SDWLSS=$P(SDWLDATA,U,8),SDWLSC=$P(SDWLDATA,U,9),SDWLDT=$P(SDWLDATA,U,2) "RTN","SDWLI",89,0) .S SDWLPROV=$P(SDWLDATA,U,13) I $D(SDWLDRG) D I SDNOK Q "RTN","SDWLI",90,0) ..S SDNOK=0 "RTN","SDWLI",91,0) ..I SDWLDTSDWLEDT) S SDNOK=1 Q "RTN","SDWLI",92,0) .; "RTN","SDWLI",93,0) .;IF STATUS IS CLOSED DO NOT DISPLAY RECORD "RTN","SDWLI",94,0) .; "RTN","SDWLI",95,0) .S SDWLCNT=SDWLCNT+1,^TMP("SDWLI",$J,SDWLCNT)=SDWLDATA_"~"_SDWLDA "RTN","SDWLI",96,0) .I $D(SDWLDISX) D "RTN","SDWLI",97,0) ..S ^TMP("SDWLI",$J,SDWLCNT,"DIS")=SDWLDIS_"^"_SDWLDDUZ_"^"_SDWLDIDT "RTN","SDWLI",98,0) ..I SDWLAPP>0 S ^TMP("SDWLI",$J,SDWLCNT,"SDAPT")=SDWLAPP "RTN","SDWLI",99,0) ..I SDOP'="" S ^TMP("SDWLI",$J,SDWLCNT,"SDOP")=SDOP "RTN","SDWLI",100,0) .I $D(SDREM) D "RTN","SDWLI",101,0) ..S ^TMP("SDWLI",$J,SDWLCNT,"REM")=SDREMR_U_SDREMRC_U_SDREMU_U_SDREMDD "RTN","SDWLI",102,0) .S ^TMP("SDWLI",$J)=SDWLCNT "RTN","SDWLI",103,0) .K SDWLDISX,SDREM "RTN","SDWLI",104,0) Q "RTN","SDWLI",105,0) ; "RTN","SDWLI",106,0) DISP ;Display Wait List Data "RTN","SDWLI",107,0) S (SDWLDT,SDWLCNT,SDWLCN)="",SDWLCT=$G(^TMP("SDWLI",$J)) I 'SDWLCT W !!,"No 'OPEN' Wait List Records to Display.",!! K DIR S DIR(0)="E" D ^DIR S DUOUT="" Q "RTN","SDWLI",108,0) F S SDWLCNT=$O(^TMP("SDWLI",$J,SDWLCNT)) Q:SDWLCNT="" D I $D(DUOUT) Q "RTN","SDWLI",109,0) .N SDWLDISX,SDWLR,SDWLCLPT "RTN","SDWLI",110,0) .I $D(^TMP("SDWLI",$J,SDWLCNT,"DIS")) S SDWLDISX=$G(^TMP("SDWLI",$J,SDWLCNT,"DIS")) "RTN","SDWLI",111,0) .I $D(^TMP("SDWLI",$J,SDWLCNT,"REM")) S SDWLR=$G(^TMP("SDWLI",$J,SDWLCNT,"REM")) D "RTN","SDWLI",112,0) ..S SDREMR=$P(SDWLR,U),SDREMRC=$P(SDWLR,U,2),SDREMU=$P(SDWLR,U,3),SDREMDD=$P(SDWLR,U,4) "RTN","SDWLI",113,0) .S X=$G(^TMP("SDWLI",$J,SDWLCNT)),SDWLDA=$P(X,"~",2),SDWLIN=$P(X,U,3),SDWLCL=$P(X,U,4),SDWLTY=$P(X,U,5),SDWLPRI=$P(X,U,11) "RTN","SDWLI",114,0) .S SDWLTYP=$S(SDWLTY=1:$P(X,U,6),SDWLTY=2:$P(X,U,7),SDWLTY=3:$P(X,U,8),SDWLTY=4:$P(X,U,9),1:"") "RTN","SDWLI",115,0) .S SDWLTYN=$S(SDWLTY=1:5,SDWLTY=2:6,SDWLTY=3:7,SDWLTY=4:8),SDWLCOM=$P($P(X,U,18),"~",1) "RTN","SDWLI",116,0) .S SDWLDUZ=$P(X,U,10),SDWLPRV=$P(X,U,12),SDWLPROV=$P(X,U,13),SDWLX=$P(X,"~",3) D "RTN","SDWLI",117,0) ..I $D(SDWLDISX) S SDWLDIS=$P(SDWLDISX,U,1),SDWLDDUZ=$P(SDWLDISX,U,2),SDWLDIDT=$P(SDWLDISX,U,3) "RTN","SDWLI",118,0) .S SDWLDT=$P(X,U,2),YY=$E(SDWLDT,1,3)+1700,YY=$E(YY,3,4),MM=$E(SDWLDT,4,5),DD=$E(SDWLDT,6,7),SDWLDTP=MM_"/"_DD_"/"_YY "RTN","SDWLI",119,0) .S SDWLDTD=$P(X,U,16),YY=$E(SDWLDTD,1,3)+1700,YY=$E(YY,3,4),MM=$E(SDWLDTD,4,5),DD=$E(SDWLDTD,6,7),SDWLDTD=MM_"/"_DD_"/"_YY "RTN","SDWLI",120,0) .;PATCH SD*5.3*394 See Note. "RTN","SDWLI",121,0) .N SDWLSCP "RTN","SDWLI",122,0) .S SDWLSCP=+$P($G(^SDWL(409.3,SDWLDA,"SC")),U,2) "RTN","SDWLI",123,0) .W !,"# ",$J(SDWLCNT,3),! "RTN","SDWLI",124,0) .W !,"Wait List - ",$$EXTERNAL^DILFD(409.3,4,,SDWLTY),?55,"Date Entered - ",SDWLDTP "RTN","SDWLI",125,0) .W !,?15 S X=$$EXTERNAL^DILFD(409.3,SDWLTYN,,SDWLTYP) W X "RTN","SDWLI",126,0) .S SDWLP=0 I SDWLPRI W !,"Priority - ",$$EXTERNAL^DILFD(409.3,10,,SDWLPRI) S SDWLP=1 "RTN","SDWLI",127,0) .I $D(SDWLSCP) W !,"Service Connected Priority - ",$$EXTERNAL^DILFD(409.3,15,,SDWLSCP) "RTN","SDWLI",128,0) .W:SDWLP ?15 W:'SDWLP ! W "Institution - ",$$EXTERNAL^DILFD(409.3,2,,SDWLIN) "RTN","SDWLI",129,0) .W !,"Entered by - " S X=$$EXTERNAL^DILFD(409.3,9,,SDWLDUZ) W X "RTN","SDWLI",130,0) .; SD*5.3*645 - replaced Date Desired with CID/Preferred Date "RTN","SDWLI",131,0) .;S SDWRB=0 I SDWLPRV W !,"Requested By - ",$$EXTERNAL^DILFD(409.3,11,,SDWLPRV),?55,"Date Desired - ",SDWLDTD "RTN","SDWLI",132,0) .S SDWRB=0 I SDWLPRV W !,"Requested By - ",$$EXTERNAL^DILFD(409.3,11,,SDWLPRV),?49,"CID/Preferred Date - ",SDWLDTD "RTN","SDWLI",133,0) .I SDWLPRV=1 W !,"Provider - ",$$EXTERNAL^DILFD(409.3,12,,SDWLPROV) "RTN","SDWLI",134,0) .I $D(SDWLCOM),SDWLCOM'="" W !,"Comments - ",SDWLCOM "RTN","SDWLI",135,0) .I $D(^TMP("SDWLI",$J,SDWLCNT,"SDOP")) N SDOP S SDOP=^("SDOP") W !,"Reopen Reason: ",$P(SDOP,U) D "RTN","SDWLI",136,0) ..I $P(SDOP,U,2)'="" W !,"Reopen comment: ",$P(SDOP,U,2) "RTN","SDWLI",137,0) .I $D(^TMP("SDWLI",$J,SDWLCNT,"REM")) W !,"Non Removal Reason - ",SDREMR,!,"Non Remove Reason entered by - ",$$GET1^DIQ(200,SDREMU_",",.01,"I") D "RTN","SDWLI",138,0) ..I $L(SDREMRC)>0 W !,"Non Removal Comment - ",SDREMRC "RTN","SDWLI",139,0) ..W !,"Non Removal entry date - ",SDREMDD "RTN","SDWLI",140,0) .I $D(^TMP("SDWLI",$J,SDWLCNT,"DIS")) W !,"Disposition - ",$$EXTERNAL^DILFD(409.3,21,,SDWLDIS),?51,"Disposition Date - ",SDWLDIDT D "RTN","SDWLI",141,0) ..W !,"Dispositioned by - ",$$EXTERNAL^DILFD(409.3,20,,SDWLDDUZ) "RTN","SDWLI",142,0) .I $D(^TMP("SDWLI",$J,SDWLCNT,"SDAPT")) N SDAP S SDAP=^("SDAPT") D "RTN","SDWLI",143,0) ..W !,"Appointment scheduled for " S Y=$P(SDAP,"~",2) D DD^%DT W Y "RTN","SDWLI",144,0) ..W !?3,"Made on: " S Y=+SDAP D DD^%DT W Y,?30,"For clinic: " N SDC S SDC=$P(SDAP,U,2) S SDC=$$GET1^DIQ(44,SDC_",",.01) W SDC "RTN","SDWLI",145,0) ..N SDAIN S SDAIN=$P(SDAP,U,3),SDAIN=$$GET1^DIQ(4,SDAIN_",",.01) "RTN","SDWLI",146,0) ..W !?3,"Appt Institution: ",SDAIN "RTN","SDWLI",147,0) ..N SDCR S SDCR=$P(SDAP,U,4),SDCR=$$GET1^DIQ(40.7,SDCR_",",.01) "RTN","SDWLI",148,0) ..W ?40,"Appt Specialty: ",SDCR "RTN","SDWLI",149,0) ..N SAPS S SAPS=$P(SDAP,U,8),SAPS=$P(SAPS,"~") I SAPS="CC" W !,"Appointment Status: Canceled by Clinic" "RTN","SDWLI",150,0) .S SDWLCLPT=$$GET1^DIQ(409.3,SDWLDA,37,"I") ; SD*5.3*446 "RTN","SDWLI",151,0) .D:SDWLCLPT ; SD*5.3*446 "RTN","SDWLI",152,0) ..W !,"Clinic changed from: ",$$GET1^DIQ(409.3,SDWLCLPT,8) "RTN","SDWLI",153,0) ..W:SDWLIN'=$$GET1^DIQ(409.3,SDWLCLPT,2,"I") " (",$$GET1^DIQ(409.3,SDWLCLPT,2),")" "RTN","SDWLI",154,0) ..Q "RTN","SDWLI",155,0) .; Inter-facility Transfer. SD*5.3*446 "RTN","SDWLI",156,0) .I $$GETTRN^SDWLIFT1(SDWLDA,.SDWLINNM,.SDWLSTN) D ENS^%ZISS W !,IOINHI,"In transfer to ",SDWLINNM," (",SDWLSTN,")",IOINORM D KILL^%ZISS "RTN","SDWLI",157,0) .D GETS^DIQ(409.3,SDWLDA,"32;33;34;36;38;39","TMP") "RTN","SDWLI",158,0) .K SDWLIN,SDWLCL,SDWLTY,SDWLPRI,SDWLDUZ,SDWLPRV,SDWLDT,SDWLDTD,SDWLDIS,SDWLDIDT,SDWLTYN,SDWLCOM,SDWLPROV,SDWLDISX,DIR,DIE,DR,SDWLINNM,SDWLSTN "RTN","SDWLI",159,0) .W !,"*****",! K DIR S DIR(0)="E" D ^DIR D "RTN","SDWLI",160,0) ..I X["^" S DUOUT=1 Q "RTN","SDWLI",161,0) ..I 'Y S DUOUT=1 Q "RTN","SDWLI",162,0) ..;I '$G(SDWLLIST) D HD "RTN","SDWLI",163,0) Q "RTN","SDWLI",164,0) HD ;Header "RTN","SDWLI",165,0) W:$D(IOF) @IOF W !!,?80-$L("Wait List - Inquiry")\2,"Wait List - Inquiry ",! "RTN","SDWLI",166,0) ;SD*5.3*327 - Correct undefined. "RTN","SDWLI",167,0) I '$D(SDWLDFN) W !! Q "RTN","SDWLI",168,0) N DFN S DFN=SDWLDFN D DEM^VADPT "RTN","SDWLI",169,0) W:$D(VADM) !,VADM(1),?40 I $D(VA("PID")) W VA("PID") "RTN","SDWLI",170,0) W !! "RTN","SDWLI",171,0) K DUOUT "RTN","SDWLI",172,0) Q "RTN","SDWLI",173,0) END ; "RTN","SDWLI",174,0) K DIR,DIC,DR,DIE,SDWLDFN,DUOUT "RTN","SDWLI",175,0) K SDNOK,SDWLBDT,SDWLCL,SDWLCN,SDWLCNT,SDWLCOM,SDWLCT,SDWLDA,SDWLDATA,SDWLDDT,SDWLDDUZ,SDWLDFN,SDWLDIDT,SDWLDIS,SDWLDISX "RTN","SDWLI",176,0) K SDWLDRG,SDWLDT,SDWLDTD,SDWLDTP,SDWLDUZ,SDLWEDT,SDWLIN,SDLWP,SDWLPRI,SDWLPROV,SDLWPRV,SDWLSC,SDWLSP,SDWLSS,SDLWST,SDWLTY "RTN","SDWLI",177,0) K SDWLTYN,SDSWLTYP,SDLWX,SDWLY,SDWRB,SDWLBDT,SDWLDISC,SDWLERR,SDWLPRON,SDXSCAT,SDWLP,SDWLTYP "RTN","SDWLI",178,0) K SDREMD,SDREMDD,SDREMR,SDREMRC,SDREMU,MM,SDWLEDT,SDWLLIST,SDWLST,SDWLX,VA,X,Y,YY "RTN","SDWLI",179,0) Q "RTN","SDWLIFT3") 0^19^B62511843^B62360655 "RTN","SDWLIFT3",1,0) SDWLIFT3 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: NEW TRANSFER ;1/5/16 10:59am "RTN","SDWLIFT3",2,0) ;;5.3;Scheduling;**415,446,645**;AUG 13 1993;Build 7 "RTN","SDWLIFT3",3,0) ; "RTN","SDWLIFT3",4,0) ; "RTN","SDWLIFT3",5,0) ;****************************************************************** "RTN","SDWLIFT3",6,0) ; CHANGE LOG "RTN","SDWLIFT3",7,0) ; "RTN","SDWLIFT3",8,0) ; DATE PATCH DESCRIPTION "RTN","SDWLIFT3",9,0) ; ---- ----- ----------- "RTN","SDWLIFT3",10,0) ; 12/12/05 SD*5.3*446 Enhancements "RTN","SDWLIFT3",11,0) ; "RTN","SDWLIFT3",12,0) Q "RTN","SDWLIFT3",13,0) EN ; INITIALIZE VARIABLES "RTN","SDWLIFT3",14,0) N DIR,DIC,DR,DIE,VADM,X,Y "RTN","SDWLIFT3",15,0) D FULL^VALM1 "RTN","SDWLIFT3",16,0) D EN2() "RTN","SDWLIFT3",17,0) D INIT^SDWLIFT1(0) "RTN","SDWLIFT3",18,0) ; VALMBCK required by List Manager "RTN","SDWLIFT3",19,0) S VALMBCK="R" "RTN","SDWLIFT3",20,0) Q "RTN","SDWLIFT3",21,0) EN2(SDWLDA) ; Entry point if Wait List has been selected elsewhere. "RTN","SDWLIFT3",22,0) ; SDWLOPT is the option to be queried. "RTN","SDWLIFT3",23,0) ; 1: Patient & Wait List Entry "RTN","SDWLIFT3",24,0) ; 2: Institution "RTN","SDWLIFT3",25,0) ; 3: Comments "RTN","SDWLIFT3",26,0) ; 4: Processing "RTN","SDWLIFT3",27,0) ; 5: Confirmation "RTN","SDWLIFT3",28,0) N SDWLOPT,SDWLOPT0 "RTN","SDWLIFT3",29,0) S SDWLOPT=2 "RTN","SDWLIFT3",30,0) I '$D(SDWLDA) S SDWLDA="",SDWLOPT=1 "RTN","SDWLIFT3",31,0) S SDWLOPT0=SDWLOPT "RTN","SDWLIFT3",32,0) F D Q:'SDWLOPT "RTN","SDWLIFT3",33,0) .N SDWLDFN,SDWLDMN,SDWLIFTN,SDWLINST,DIC,DIE,DIR,DA,DO,I,Y,%,DIWETXT "RTN","SDWLIFT3",34,0) .I SDWLOPT=1 D "RTN","SDWLIFT3",35,0) ..N DFN,SDWLOK,SDWLOUT,SDWLC,SDWLI,SDWLNM,SDWLTMP "RTN","SDWLIFT3",36,0) ..K Y,X "RTN","SDWLIFT3",37,0) ..S DIC=2,DIC(0)="AEMZ",DIC("S")="I $$ISEWL^SDWLIFT3(+Y)" "RTN","SDWLIFT3",38,0) ..D ^DIC "RTN","SDWLIFT3",39,0) ..I Y=-1 S SDWLOPT=0 Q "RTN","SDWLIFT3",40,0) ..S DFN=+Y ; DFN used to uniquely identify the patient in the following look-up. "RTN","SDWLIFT3",41,0) ..D LIST^DIC(409.3,,".01;2;4;5;6;7;8",,,,$P(Y,U,2),,"I $$ISEWL2^SDWLIFT3(Y,DFN)",,"SDWLTMP") "RTN","SDWLIFT3",42,0) ..F I=1:1:+SDWLTMP("DILIST",0) D "RTN","SDWLIFT3",43,0) ...N TMP,SDWLSTA "RTN","SDWLIFT3",44,0) ...S TMP="" "RTN","SDWLIFT3",45,0) ...I SDWLTMP("DILIST","ID",I,2)'="" S TMP=TMP_SDWLTMP("DILIST","ID",I,2)_" " "RTN","SDWLIFT3",46,0) ...D:SDWLTMP("DILIST","ID",I,4)'="" "RTN","SDWLIFT3",47,0) ....S SDWLTMP("WLTY",I,0)=SDWLTMP("DILIST","ID",I,4),SDWLSTA=$$GET1^DIQ(409.3,SDWLTMP("DILIST",2,I),4,"I") "RTN","SDWLIFT3",48,0) ....I SDWLTMP("DILIST","ID",I,SDWLSTA+4)'="" S SDWLTMP("WLTY",I,0)=SDWLTMP("WLTY",I,0)_" ("_SDWLTMP("DILIST","ID",I,SDWLSTA+4)_")" "RTN","SDWLIFT3",49,0) ....S TMP=TMP_SDWLTMP("WLTY",I,0) "RTN","SDWLIFT3",50,0) ....Q "RTN","SDWLIFT3",51,0) ...S $P(DIR(0),";",I)=I_":"_TMP "RTN","SDWLIFT3",52,0) ...Q "RTN","SDWLIFT3",53,0) ..; If there is only one EWL entry, use that. The previous look-up will have ensured there is at least one. "RTN","SDWLIFT3",54,0) ..; If there are more than one, call ^DIR to select. "RTN","SDWLIFT3",55,0) ..S Y=1 "RTN","SDWLIFT3",56,0) ..I +SDWLTMP("DILIST",0)>1 S DIR(0)="S^"_DIR(0),DIR("A")="Enter 1 - "_+SDWLTMP("DILIST",0) D ^DIR Q:Y="^" "RTN","SDWLIFT3",57,0) ..W !?4,"Institution:",?20,SDWLTMP("DILIST","ID",Y,2) "RTN","SDWLIFT3",58,0) ..W !?4,"Wait List Type:",?20,$G(SDWLTMP("WLTY",Y,0)) "RTN","SDWLIFT3",59,0) ..S SDWLDA=SDWLTMP("DILIST",2,Y) "RTN","SDWLIFT3",60,0) ..I $D(^SDWL(409.36,"C",SDWLDA)) S SDWLOK=0 D I SDWLOK S SDWLOPT=0 Q "RTN","SDWLIFT3",61,0) ...N SDWLIFTN,SDWLSTN "RTN","SDWLIFT3",62,0) ...S SDWLIFTN=$O(^SDWL(409.36,"C",SDWLDA,"")),SDWLSTN=$$GET1^DIQ(409.36,SDWLIFTN,".1") "RTN","SDWLIFT3",63,0) ...S DIR(0)="E",DIR("A")="Press return to continue" "RTN","SDWLIFT3",64,0) ...S DIR("A",1)="This EWL Entry is the result of a transfer request from "_$$GET1^DIQ(4,SDWLSTN,".01")_" ("_SDWLSTN_")" "RTN","SDWLIFT3",65,0) ...;S DIR("A",2)="On acceptance at the destination facility, this EWL Entry will be removed." "RTN","SDWLIFT3",66,0) ...S DIR("A",2)="To transfer care, close the EWL Entry as ER - ENTERED IN ERROR and reject the" "RTN","SDWLIFT3",67,0) ...S DIR("A",3)="request. "_$$GET1^DIQ(4,SDWLSTN,".01")_" can then request the transfer." "RTN","SDWLIFT3",68,0) ...D ^DIR "RTN","SDWLIFT3",69,0) ...S SDWLOK=1 "RTN","SDWLIFT3",70,0) ...Q "RTN","SDWLIFT3",71,0) ..S SDWLOPT=2 "RTN","SDWLIFT3",72,0) ..Q "RTN","SDWLIFT3",73,0) .D:SDWLOPT=2 "RTN","SDWLIFT3",74,0) ..N SDWLY "RTN","SDWLIFT3",75,0) ..S SDWLDFN=$$GET1^DIQ(409.3,SDWLDA,.01,"I") "RTN","SDWLIFT3",76,0) ..S DIC=4 "RTN","SDWLIFT3",77,0) ..S DIC(0)="EMNQA" "RTN","SDWLIFT3",78,0) ..S DIC("A")="Select Institution to transfer to: " "RTN","SDWLIFT3",79,0) ..S DIC("S")="I $P(^DIC(4,+Y,0),U,11)=""N"",'+$P($G(^DIC(4,+Y,99)),U,4),$L($P($G(^DIC(4,+Y,99)),U))=3,$$GET1^DIQ(4,Y,13)=""VAMC""" "RTN","SDWLIFT3",80,0) ..D ^DIC "RTN","SDWLIFT3",81,0) ..I Y=-1 S SDWLOPT=$S(SDWLOPT0=2:0,1:1) Q ; If the call was made to go straight to Institution, quit out if no institution is selected. "RTN","SDWLIFT3",82,0) ..S SDWLY=+Y,SDWLDMN=$$GET1^DIQ(4,SDWLY,60) "RTN","SDWLIFT3",83,0) ..I SDWLDMN="" W !,"This Institution does not have a Domain to which the request can be sent." Q "RTN","SDWLIFT3",84,0) ..S SDWLINST=SDWLY,SDWLOPT=3 "RTN","SDWLIFT3",85,0) ..Q "RTN","SDWLIFT3",86,0) .D:SDWLOPT=3 "RTN","SDWLIFT3",87,0) ..S DIC="^TMP(""SDWLIFT"",$J,""COMMENT""",DIWETXT="Transfer comments" "RTN","SDWLIFT3",88,0) ..W !,DIWETXT "RTN","SDWLIFT3",89,0) ..K @(DIC_")") S DIC=DIC_"," "RTN","SDWLIFT3",90,0) ..D EN^DIWE "RTN","SDWLIFT3",91,0) ..S SDWLOPT=4 "RTN","SDWLIFT3",92,0) ..Q "RTN","SDWLIFT3",93,0) .D:SDWLOPT=4 "RTN","SDWLIFT3",94,0) ..N SDWLDTM "RTN","SDWLIFT3",95,0) ..K DIC "RTN","SDWLIFT3",96,0) ..S DIR(0)="Y",DIR("A")="OK to send",DIR("B")="YES" D ^DIR "RTN","SDWLIFT3",97,0) ..I 'Y S SDWLOPT=0 Q "RTN","SDWLIFT3",98,0) ..S DIC=409.35,DIC(0)="Z",X=SDWLDA "RTN","SDWLIFT3",99,0) ..D FILE^DICN "RTN","SDWLIFT3",100,0) ..S SDWLIFTN=+Y "RTN","SDWLIFT3",101,0) ..S DA(1)=+Y,DIC=DIC_DA(1)_",1,",SDWLI=0 "RTN","SDWLIFT3",102,0) ..F S SDWLI=$O(^TMP("SDWLIFT",$J,"COMMENT",SDWLI)) Q:'SDWLI S X=^TMP("SDWLIFT",$J,"COMMENT",SDWLI,0) K DO D FILE^DICN "RTN","SDWLIFT3",103,0) ..D NOW^%DTC S SDWLDTM=% "RTN","SDWLIFT3",104,0) ..S DIE=409.35,DR="1///"_$$GET1^DIQ(4,SDWLINST,99)_";2///"_SDWLDTM_";3///P;4///`"_DUZ "RTN","SDWLIFT3",105,0) ..D ^DIE "RTN","SDWLIFT3",106,0) ..D MSG "RTN","SDWLIFT3",107,0) ..S SDWLOPT=0 K DIR "RTN","SDWLIFT3",108,0) ..;S DIR(0)="E" D ^DIR "RTN","SDWLIFT3",109,0) ..Q "RTN","SDWLIFT3",110,0) .Q "RTN","SDWLIFT3",111,0) Q "RTN","SDWLIFT3",112,0) ; "RTN","SDWLIFT3",113,0) ISEWL(DFN) ; Filter for seach of PATIENT file ; OG ; SD*5.3*446 "RTN","SDWLIFT3",114,0) N SDWLOK,SDWLDA "RTN","SDWLIFT3",115,0) S SDWLOK=0 "RTN","SDWLIFT3",116,0) Q:'$D(^SDWL(409.3,"B",DFN)) SDWLOK "RTN","SDWLIFT3",117,0) S SDWLDA=0 "RTN","SDWLIFT3",118,0) F S SDWLDA=$O(^SDWL(409.3,"B",DFN,SDWLDA)) Q:'SDWLDA I $$ISEWL2(SDWLDA,DFN) S SDWLOK=1 Q "RTN","SDWLIFT3",119,0) Q SDWLOK "RTN","SDWLIFT3",120,0) ; "RTN","SDWLIFT3",121,0) ISEWL2(SDWLDA,DFN) ; If the EWL entry exists, is not closed, is a team or team position assignment and not already in transit. "RTN","SDWLIFT3",122,0) N TMP "RTN","SDWLIFT3",123,0) ;Q $$GET1^DIQ(409.3,SDWLDA,23,"I")'="C"&'$$GETTRN^SDWLIFT1(SDWLDA)&($$GET1^DIQ(409.3,SDWLDA,.01,"I")=DFN) old way of doing it. "RTN","SDWLIFT3",124,0) D GETS^DIQ(409.3,SDWLDA_",",".01;4;23","I","TMP") "RTN","SDWLIFT3",125,0) Q:$G(TMP(409.3,SDWLDA_",",.01,"I"))'=DFN 0 "RTN","SDWLIFT3",126,0) Q TMP(409.3,SDWLDA_",",23,"I")'="C"&("^1^2^"[("^"_TMP(409.3,SDWLDA_",",4,"I")_"^"))&'$$GETTRN^SDWLIFT1(SDWLDA) "RTN","SDWLIFT3",127,0) ; "RTN","SDWLIFT3",128,0) MSG ;acknowledgement notification to destination "RTN","SDWLIFT3",129,0) N SDWLDA,SDWLDTM,DFN,TMP,SDWLTY,SDWLX,SDWLI,DIE,DA,DR,VAPA,WP "RTN","SDWLIFT3",130,0) N XMSUB,XMY,XMTEXT,XMDUZ,SDWLX,SDWLI "RTN","SDWLIFT3",131,0) S XMSUB="SDWL TRANSFER REQUEST" "RTN","SDWLIFT3",132,0) S XMY("S.SDWL-XFER-SERVER@"_SDWLDMN)="" "RTN","SDWLIFT3",133,0) S XMTEXT="SDWLX(" "RTN","SDWLIFT3",134,0) S XMDUZ="POSTMASTER" "RTN","SDWLIFT3",135,0) D NOW^%DTC S SDWLDTM=% "RTN","SDWLIFT3",136,0) S SDWLDA=$$GET1^DIQ(409.35,SDWLIFTN,.01,"I") "RTN","SDWLIFT3",137,0) D GETS^DIQ(409.3,SDWLDA,".01;4;22","I","TMP") "RTN","SDWLIFT3",138,0) S DFN=TMP(409.3,SDWLDA_",",.01,"I") "RTN","SDWLIFT3",139,0) S SDWLTY=TMP(409.3,SDWLDA_",",4,"I") "RTN","SDWLIFT3",140,0) D DEM^VADPT,ADD^VADPT "RTN","SDWLIFT3",141,0) D GETS^DIQ(2,DFN,".301;.302;991.01","I","TMP") "RTN","SDWLIFT3",142,0) S SDWLX(0)=0 "RTN","SDWLIFT3",143,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".01"_U_"NAME"_U_VADM(1) "RTN","SDWLIFT3",144,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".02"_U_"SEX"_U_$P(VADM(5),U) "RTN","SDWLIFT3",145,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".03"_U_"DATE OF BIRTH"_U_$P(VADM(3),U) "RTN","SDWLIFT3",146,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".09"_U_"SOCIAL SECURITY NUMBER"_U_$P(VADM(2),U) "RTN","SDWLIFT3",147,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".1"_U_"REQUESTING STATION NUMBER"_U_$P($$SITE^VASITE(),U,3) "RTN","SDWLIFT3",148,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".111"_U_"STREET ADDRESS [LINE 1]"_U_VAPA(1) "RTN","SDWLIFT3",149,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".112"_U_"STREET ADDRESS [LINE 2]"_U_VAPA(2) "RTN","SDWLIFT3",150,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".113"_U_"STREET ADDRESS [LINE 3]"_U_VAPA(3) "RTN","SDWLIFT3",151,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".114"_U_"CITY"_U_VAPA(4) "RTN","SDWLIFT3",152,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".115"_U_"STATE"_U_VAPA(5) "RTN","SDWLIFT3",153,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".116"_U_"ZIP CODE"_U_VAPA(6) "RTN","SDWLIFT3",154,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".117"_U_"COUNTY"_U_$P(VAPA(7),U) "RTN","SDWLIFT3",155,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".1217"_U_"TEMPORARY ADDRESS START DATE"_U_$P(VAPA(9),U) "RTN","SDWLIFT3",156,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".1218"_U_"TEMPORARY ADDRESS END DATE"_U_$P(VAPA(10),U) "RTN","SDWLIFT3",157,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".131"_U_"PHONE NUMBER [RESIDENCE]"_U_VAPA(8) "RTN","SDWLIFT3",158,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".301"_U_"SERVICE CONNECTED?"_U_TMP(2,DFN_",",.301,"I") "RTN","SDWLIFT3",159,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".302"_U_"SERVICE CONNECTED PERCENTAGE"_U_TMP(2,DFN_",",.302,"I") "RTN","SDWLIFT3",160,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".361"_U_"PRIMARY ELIGIBILITY CODE"_U_$$GET1^DIQ(2,DFN,.361) "RTN","SDWLIFT3",161,0) S X=$$GET1^DIQ(409.35,SDWLIFTN_",",5,"Z","WP") "RTN","SDWLIFT3",162,0) S SDWLI=0 F S SDWLI=$O(WP(SDWLI)) Q:'SDWLI S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".4"_U_"COMMENTS"_U_WP(SDWLI,0) "RTN","SDWLIFT3",163,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=".5"_U_"SENDING FACILITY TRANSFER ID"_U_SDWLIFTN "RTN","SDWLIFT3",164,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=2_U_"TRANSMISSION DATE/TIME"_U_SDWLDTM "RTN","SDWLIFT3",165,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=4_U_"WAIT LIST TYPE"_U_SDWLTY "RTN","SDWLIFT3",166,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=5_U_"WAIT LIST TYPE EXTENSION"_U_$$GET1^DIQ(409.3,SDWLDA,4+SDWLTY) "RTN","SDWLIFT3",167,0) ; SD*5.3*645 - replaced DESIRED DATE with CID/PREFERRED DATE "RTN","SDWLIFT3",168,0) ;S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=22_U_"DESIRED DATE OF APPOINTMENT"_U_TMP(409.3,SDWLDA_",",22,"I") "RTN","SDWLIFT3",169,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))=22_U_"CID/PREFERRED DATE OF APPOINTMENT"_U_TMP(409.3,SDWLDA_",",22,"I") "RTN","SDWLIFT3",170,0) S SDWLX(0)=SDWLX(0)+1,SDWLX(SDWLX(0))="991.01"_U_"INTEGRATION CONTROL NUMBER"_U_TMP(2,DFN_",",991.01,"I") "RTN","SDWLIFT3",171,0) D ^XMD "RTN","SDWLIFT3",172,0) ; Change status of transfer file to TRANSMITTED "RTN","SDWLIFT3",173,0) S DIE=409.35,DA=SDWLIFTN,DR="3///T" D ^DIE "RTN","SDWLIFT3",174,0) ; Update the EWL Disposition code "RTN","SDWLIFT3",175,0) S DIE=409.3,DA=SDWLDA,DR="21///TR" D ^DIE "RTN","SDWLIFT3",176,0) Q "RTN","SDWLIFT6") 0^20^B60758561^B60221443 "RTN","SDWLIFT6",1,0) SDWLIFT6 ;IOFO BAY PINES/OG - INTER-FACILITY TRANSFER: DISPLAY ACCEPT DETAILS ;1/5/16 11:00am "RTN","SDWLIFT6",2,0) ;;5.3;Scheduling;**415,446,645**;AUG 13 1993;Build 7 "RTN","SDWLIFT6",3,0) ; "RTN","SDWLIFT6",4,0) ; "RTN","SDWLIFT6",5,0) ;****************************************************************** "RTN","SDWLIFT6",6,0) ; CHANGE LOG "RTN","SDWLIFT6",7,0) ; "RTN","SDWLIFT6",8,0) ; DATE PATCH DESCRIPTION "RTN","SDWLIFT6",9,0) ; ---- ----- ----------- "RTN","SDWLIFT6",10,0) ; 04/14/2006 SD*5.3*446 INTER-FACILITY TRANSFER "RTN","SDWLIFT6",11,0) ; "RTN","SDWLIFT6",12,0) Q "RTN","SDWLIFT6",13,0) EN ; INITIALIZE VARIABLES FOR DISPLAY "RTN","SDWLIFT6",14,0) N DFN,SDWLI,SDWLOK,SDWLIFN0 "RTN","SDWLIFT6",15,0) K SDWLLIST "RTN","SDWLIFT6",16,0) D GETLIST^SDWLIFT5 "RTN","SDWLIFT6",17,0) S (SDWLIFTN,SDWLIFN0)=$$GETTN^SDWLIFT(.SDWLLIST) "RTN","SDWLIFT6",18,0) I 'SDWLIFTN S VALMBCK="R" Q "RTN","SDWLIFT6",19,0) L +^SDWL(409.36,SDWLIFTN):10 I '$T S VALMBCK="R" Q "RTN","SDWLIFT6",20,0) ; Refresh list and loop to ensure that the selection hasn't been removed while the choice was being made. "RTN","SDWLIFT6",21,0) K SDWLLIST D GETLIST^SDWLIFT5 "RTN","SDWLIFT6",22,0) S (SDWLOK,SDWLI)=0 F S SDWLI=$O(SDWLLIST(SDWLI)) Q:'SDWLI I SDWLLIST(SDWLI,1)=SDWLIFTN S SDWLOK=1 Q "RTN","SDWLIFT6",23,0) D:SDWLOK "RTN","SDWLIFT6",24,0) .N DIC,DFN,SDWLDFN,SDWLICN,SDWLSSN,SDWLTY,X,Y "RTN","SDWLIFT6",25,0) .S SDWLICN=$$GET1^DIQ(409.36,SDWLIFTN,991.01) "RTN","SDWLIFT6",26,0) .S SDWLSSN=$$GET1^DIQ(409.36,SDWLIFTN,.09) "RTN","SDWLIFT6",27,0) .S (DFN,SDWLDFN)=$S(+SDWLICN:$O(^DPT("AICN",SDWLICN,"")),1:"") "RTN","SDWLIFT6",28,0) .I DFN="" S (DFN,SDWLDFN)=$S(+SDWLSSN:$O(^DPT("SSN",SDWLSSN,"")),1:"") "RTN","SDWLIFT6",29,0) .S SDWLTY=$$GET1^DIQ(409.36,SDWLIFTN,4,"I") "RTN","SDWLIFT6",30,0) .D EN^VALM("SDWL TRANSFER ACC VIEW") "RTN","SDWLIFT6",31,0) .Q "RTN","SDWLIFT6",32,0) L -^SDWL(409.36,SDWLIFN0) "RTN","SDWLIFT6",33,0) D INIT^SDWLIFT5 "RTN","SDWLIFT6",34,0) S VALMBCK="R" "RTN","SDWLIFT6",35,0) Q "RTN","SDWLIFT6",36,0) INIT ; Default initialization options. "RTN","SDWLIFT6",37,0) N SDWLINFO "RTN","SDWLIFT6",38,0) D GETINFO(.SDWLINFO) "RTN","SDWLIFT6",39,0) F VALMCNT=1:1:SDWLINFO(0) D SET^VALM10(VALMCNT,SDWLINFO(VALMCNT,0)) "RTN","SDWLIFT6",40,0) Q "RTN","SDWLIFT6",41,0) GETINFO(SDWLOUT) ; The Coversheet function calls here too. "RTN","SDWLIFT6",42,0) N DIC,D,X,WP,TMP,SDWLADD,SDWLFID,SDWLI "RTN","SDWLIFT6",43,0) D GETS^DIQ(409.36,SDWLIFTN,"*",,"TMP") "RTN","SDWLIFT6",44,0) S SDWLOUT(0)=1 "RTN","SDWLIFT6",45,0) D:SDWLDFN="" "RTN","SDWLIFT6",46,0) .S SDWLOUT(SDWLOUT(0),0)="Patient not registered" "RTN","SDWLIFT6",47,0) .S SDWLOUT(0)=SDWLOUT(0)+1 "RTN","SDWLIFT6",48,0) .D CNTRL^VALM10(1,1,22,IOINHI,IOINORM) "RTN","SDWLIFT6",49,0) .Q "RTN","SDWLIFT6",50,0) S SDWLOUT(SDWLOUT(0),0)="Transmg. Inst: "_$E($$GET1^DIQ(4,$$FIND1^DIC(4,"","X",TMP(409.36,SDWLIFTN_",",.1),"D"),.01)_SDWLSPS,1,28)_" " "RTN","SDWLIFT6",51,0) S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_"Transmn. Date: "_TMP(409.36,SDWLIFTN_",",.2) "RTN","SDWLIFT6",52,0) S SDWLOUT(0)=SDWLOUT(0)+1 "RTN","SDWLIFT6",53,0) S SDWLOUT(SDWLOUT(0),0)="Name: "_$E(TMP(409.36,SDWLIFTN_",",.01)_SDWLSPS,1,27)_" " "RTN","SDWLIFT6",54,0) S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_"Sex: "_$E(TMP(409.36,SDWLIFTN_",",.02)_SDWLSPS,1,7) "RTN","SDWLIFT6",55,0) S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_"DoB: "_$E(TMP(409.36,SDWLIFTN_",",.03)_SDWLSPS,1,13) "RTN","SDWLIFT6",56,0) S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_"SSN: "_TMP(409.36,SDWLIFTN_",",.09) "RTN","SDWLIFT6",57,0) ; "RTN","SDWLIFT6",58,0) S SDWLOUT(0)=SDWLOUT(0)+1,SDWLADD=SDWLOUT(0) "RTN","SDWLIFT6",59,0) S SDWLOUT(SDWLOUT(0),0)=$E("Address: "_TMP(409.36,SDWLIFTN_",",.111)_SDWLSPS,1,58)_" Status: "_TMP(409.36,SDWLIFTN_",",1) "RTN","SDWLIFT6",60,0) F SDWLFID=.112:.001:.114,.117 I TMP(409.36,SDWLIFTN_",",SDWLFID)'="" S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)=$E(SDWLSPS,1,9)_TMP(409.36,SDWLIFTN_",",SDWLFID) "RTN","SDWLIFT6",61,0) I TMP(409.36,SDWLIFTN_",",.115)_TMP(409.36,SDWLIFTN_",",.116)'="" D "RTN","SDWLIFT6",62,0) .S SDWLOUT(0)=SDWLOUT(0)+1 "RTN","SDWLIFT6",63,0) .S SDWLOUT(SDWLOUT(0),0)=$E(SDWLSPS,1,9) "RTN","SDWLIFT6",64,0) .I TMP(409.36,SDWLIFTN_",",.115)'="" S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_TMP(409.36,SDWLIFTN_",",.115) "RTN","SDWLIFT6",65,0) .S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_" "_TMP(409.36,SDWLIFTN_",",.116) "RTN","SDWLIFT6",66,0) .Q "RTN","SDWLIFT6",67,0) I TMP(409.36,SDWLIFTN_",",.131)'="" S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Phone no "_TMP(409.36,SDWLIFTN_",",.131) "RTN","SDWLIFT6",68,0) D:TMP(409.36,SDWLIFTN_",",.1217)'="" ; Temporary address details. Displayed to the right of the address in up to 3 lines starting column 62 "RTN","SDWLIFT6",69,0) .S SDWLOUT(SDWLADD,0)=$E(SDWLOUT(SDWLADD,0)_SDWLSPS,1,61)_"Temporary address" ; There should be at least three lines if it is also indicated as temporary. "RTN","SDWLIFT6",70,0) .S SDWLOUT(SDWLADD+1,0)=$E(SDWLOUT(SDWLADD+1,0)_SDWLSPS,1,61)_"From: "_TMP(409.36,SDWLIFTN_",",.1217) "RTN","SDWLIFT6",71,0) .S SDWLOUT(SDWLADD+2,0)=$E(SDWLOUT(SDWLADD+2,0)_SDWLSPS,1,61)_"To : "_TMP(409.36,SDWLIFTN_",",.1218) "RTN","SDWLIFT6",72,0) .Q "RTN","SDWLIFT6",73,0) S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Service connected: "_TMP(409.36,SDWLIFTN_",",.301) "RTN","SDWLIFT6",74,0) I TMP(409.36,SDWLIFTN_",",.301)="YES" S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_" Percentage: "_TMP(409.36,SDWLIFTN_",",.302) "RTN","SDWLIFT6",75,0) S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Primary Eligibility: "_TMP(409.36,SDWLIFTN_",",.361) "RTN","SDWLIFT6",76,0) S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Wait List Type: " "RTN","SDWLIFT6",77,0) S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_TMP(409.36,SDWLIFTN_",",4)_" : "_TMP(409.36,SDWLIFTN_",",5) "RTN","SDWLIFT6",78,0) ; SD*5.3*645 - replaced Desired Date with CID/Preferred Date when presented to the user "RTN","SDWLIFT6",79,0) ;S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Desired Date of Appt: " "RTN","SDWLIFT6",80,0) S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="CID/Preferred Date of Appt: " "RTN","SDWLIFT6",81,0) S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_TMP(409.36,SDWLIFTN_",",22) "RTN","SDWLIFT6",82,0) S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_" Integration Control Number: " "RTN","SDWLIFT6",83,0) S SDWLOUT(SDWLOUT(0),0)=SDWLOUT(SDWLOUT(0),0)_TMP(409.36,SDWLIFTN_",",991.01) "RTN","SDWLIFT6",84,0) S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)="Comments: " "RTN","SDWLIFT6",85,0) S X=$$GET1^DIQ(409.36,SDWLIFTN_",",.4,"Z","WP") "RTN","SDWLIFT6",86,0) S SDWLI=0 F S SDWLI=$O(WP(SDWLI)) Q:'SDWLI S SDWLOUT(0)=SDWLOUT(0)+1,SDWLOUT(SDWLOUT(0),0)=WP(SDWLI,0) "RTN","SDWLIFT6",87,0) Q "RTN","SDWLIFT6",88,0) GETTN(SDWLLIST) ; Get transfer id. "RTN","SDWLIFT6",89,0) N DIR,Y "RTN","SDWLIFT6",90,0) I 'SDWLLIST(0) S DIR(0)="Y",DIR("A")="No entries. OK",DIR("B")="YES" D ^DIR Q 0 "RTN","SDWLIFT6",91,0) I SDWLLIST(0)=1 S Y=1 ; If there is only one, don't ask. "RTN","SDWLIFT6",92,0) E S DIR(0)="L^1:"_SDWLLIST(0),DIR("A")="Which entry?" D ^DIR "RTN","SDWLIFT6",93,0) Q $G(SDWLLIST(+Y,1),0) "RTN","SDWLIFT6",94,0) HD ; -- Make header line for list processor "RTN","SDWLIFT6",95,0) S (VALMHDR(1),VALMHDR(2))="" "RTN","SDWLIFT6",96,0) Q "RTN","SDWLIFT6",97,0) PCMM(SDWLIFTN,DFN) ; "RTN","SDWLIFT6",98,0) N SDWLPCMM,SDWLRES,DIE,DA,DR "RTN","SDWLIFT6",99,0) I $G(DFN)="" W !,"Patient not entered on the system. Use Load/edit" S DIR(0)="E",VALMBCK="R" D ^DIR Q "RTN","SDWLIFT6",100,0) S (SDWLPCMM,SDWLRES)=0 "RTN","SDWLIFT6",101,0) D PAT^SCMCQK "RTN","SDWLIFT6",102,0) ;If a PCMM assignment was made, close 409.36 "RTN","SDWLIFT6",103,0) ;if an EWL Entry was created instead, add pointer "RTN","SDWLIFT6",104,0) ;then pass a message back. "RTN","SDWLIFT6",105,0) Q:'SDWLPCMM&'SDWLRES "RTN","SDWLIFT6",106,0) S DIE="^SDWL(409.36,",DA=SDWLIFTN "RTN","SDWLIFT6",107,0) I SDWLPCMM S DR="1///C" "RTN","SDWLIFT6",108,0) E S DR="409.3///"_$P(SDWLRES,U,2) "RTN","SDWLIFT6",109,0) D ^DIE,SENDST(SDWLIFTN) "RTN","SDWLIFT6",110,0) Q "RTN","SDWLIFT6",111,0) ; "RTN","SDWLIFT6",112,0) ACCEPT ; Sign the transaction off as accepted. Remove the temporary file and send a message to transmitting facility "RTN","SDWLIFT6",113,0) N DIR "RTN","SDWLIFT6",114,0) I $$GET1^DIQ(409.36,SDWLIFTN,.3)'="YES" D Q "RTN","SDWLIFT6",115,0) .S DIR("A")="A coversheet does not appear to have been requested."_$C(13,10)_"This is required before acceptance. Enter RETURN to continue or '^' to exit" "RTN","SDWLIFT6",116,0) .S DIR(0)="E" "RTN","SDWLIFT6",117,0) .D ^DIR "RTN","SDWLIFT6",118,0) .S VALMBCK=$S(Y:"R",1:"Q") "RTN","SDWLIFT6",119,0) .Q "RTN","SDWLIFT6",120,0) D FULL^VALM1 "RTN","SDWLIFT6",121,0) S DIR(0)="Y" "RTN","SDWLIFT6",122,0) S DIR("A")="Do you confirm that the appropriate action was taken to schedule this patient"_$C(13,10)_"for an appointment or she/he has EWL entry and the cover sheet has been printed" "RTN","SDWLIFT6",123,0) S DIR("B")="N" "RTN","SDWLIFT6",124,0) D ^DIR "RTN","SDWLIFT6",125,0) D:Y "RTN","SDWLIFT6",126,0) .N SDWLSTN,SDWLINST,XMY,XMSUB,XMTEXT,XMDUZ,SDWLX,DA,DIK "RTN","SDWLIFT6",127,0) .S SDWLSTN=$$GET1^DIQ(409.36,SDWLIFTN,.1) "RTN","SDWLIFT6",128,0) .S SDWLINST=$$FIND1^DIC(4,"","X",SDWLSTN,"D") "RTN","SDWLIFT6",129,0) .S XMY("S.SDWL-XFER-SERVER@"_$$GET1^DIQ(4,SDWLINST,60))="" "RTN","SDWLIFT6",130,0) .S XMSUB="SDWL TRANSFER ACCEPTANCE" "RTN","SDWLIFT6",131,0) .S XMTEXT="SDWLX(" "RTN","SDWLIFT6",132,0) .S XMDUZ="POSTMASTER" "RTN","SDWLIFT6",133,0) .S SDWLX(1,0)=".5"_U_"SENDING FACILITY TRANSFER ID"_U_$$GET1^DIQ(409.36,SDWLIFTN,.5) "RTN","SDWLIFT6",134,0) .S SDWLX(2,0)="7"_U_"ACCEPTING PERSON"_U_$$GET1^DIQ(200,DUZ,.01) "RTN","SDWLIFT6",135,0) .S SDWLX(0)=2 "RTN","SDWLIFT6",136,0) .D ^XMD "RTN","SDWLIFT6",137,0) .S DA=SDWLIFTN,DIK="^SDWL(409.36," D ^DIK "RTN","SDWLIFT6",138,0) .Q "RTN","SDWLIFT6",139,0) S VALMBCK="Q" "RTN","SDWLIFT6",140,0) Q "RTN","SDWLIFT6",141,0) REJECT ; Sign the transaction off as rejected. Remove the temporary file and send a message to transmitting facility "RTN","SDWLIFT6",142,0) N SDWLSTN,SDWLINST,XMSUB,XMY,XMTEXT,XMDUZ,SDWLX "RTN","SDWLIFT6",143,0) S SDWLSTN=$$GET1^DIQ(409.36,SDWLIFTN,.1) "RTN","SDWLIFT6",144,0) S SDWLINST=$$FIND1^DIC(4,"","X",SDWLSTN,"D") "RTN","SDWLIFT6",145,0) S XMY("S.SDWL-XFER-SERVER@"_$$GET1^DIQ(4,SDWLINST,60))="" "RTN","SDWLIFT6",146,0) S XMSUB="SDWL TRANSFER REJECTION" "RTN","SDWLIFT6",147,0) S XMTEXT="SDWLX(" "RTN","SDWLIFT6",148,0) S XMDUZ="POSTMASTER" "RTN","SDWLIFT6",149,0) S SDWLX(1,0)=".5"_U_"SENDING FACILITY TRANSFER ID"_U_$$GET1^DIQ(409.36,SDWLIFTN,.5) "RTN","SDWLIFT6",150,0) S SDWLX(0)=1 "RTN","SDWLIFT6",151,0) D ^XMD "RTN","SDWLIFT6",152,0) S DA=SDWLIFTN,DIK="^SDWL(409.36," D ^DIK "RTN","SDWLIFT6",153,0) ;teh/05/20/2005 cleans the SDWLLIST array and reset count. "RTN","SDWLIFT6",154,0) K SDWLLIST(SDWLIFTN) "RTN","SDWLIFT6",155,0) S SDWLLIST(0)=SDWLLIST(0)-1 "RTN","SDWLIFT6",156,0) S VALMBCK="Q" "RTN","SDWLIFT6",157,0) EXIT ; Tidy up "RTN","SDWLIFT6",158,0) K SDWLIFTN "RTN","SDWLIFT6",159,0) Q "RTN","SDWLIFT6",160,0) SENDST(SDWLIFTN) ; Send status change notification "RTN","SDWLIFT6",161,0) N SDWLSTN,SDWLINST,TMP,XMSUB,XMY,XMTEXT,XMDUZ,SDWLX,SDWLDA,SDWLDIS "RTN","SDWLIFT6",162,0) S SDWLDA=$$GET1^DIQ(409.36,SDWLIFTN,409.3,"I"),SDWLDIS=$$GET1^DIQ(409.3,SDWLDA,21,"I") "RTN","SDWLIFT6",163,0) D GETS^DIQ(409.36,SDWLIFTN,".1;.5;1;2","I","TMP") "RTN","SDWLIFT6",164,0) S SDWLSTN=TMP(409.36,SDWLIFTN_",",.1,"I") "RTN","SDWLIFT6",165,0) S SDWLINST=$$FIND1^DIC(4,"","X",SDWLSTN,"D") "RTN","SDWLIFT6",166,0) S XMY("S.SDWL-XFER-SERVER@"_$$GET1^DIQ(4,SDWLINST,60))="" "RTN","SDWLIFT6",167,0) S XMSUB="SDWL TRANSFER STATUS CHANGE" "RTN","SDWLIFT6",168,0) S XMTEXT="SDWLX(" "RTN","SDWLIFT6",169,0) S XMDUZ="POSTMASTER" "RTN","SDWLIFT6",170,0) S SDWLX(1,0)=.5_U_"SENDING FACILITY TRANSFER ID"_U_TMP(409.36,SDWLIFTN_",",.5,"I") "RTN","SDWLIFT6",171,0) S SDWLX(2,0)=1_U_"STATUS"_U_TMP(409.36,SDWLIFTN_",",1,"I") "RTN","SDWLIFT6",172,0) S SDWLX(3,0)=7_U_"ACCEPTING PERSON"_U_$$GET1^DIQ(200,DUZ,.01) "RTN","SDWLIFT6",173,0) S SDWLX(4,0)=2_U_"FACILITY TRANFERRED TO"_U_TMP(409.36,SDWLIFTN_",",2,"I") "RTN","SDWLIFT6",174,0) S SDWLX(5,0)=21_U_"DISPOSITION"_U_SDWLDIS "RTN","SDWLIFT6",175,0) S SDWLX(0)=5 "RTN","SDWLIFT6",176,0) D ^XMD "RTN","SDWLIFT6",177,0) Q "RTN","SDWLRAD") 0^22^B20910333^B20939529 "RTN","SDWLRAD",1,0) SDWLRAD ;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT ;1/5/16 4:21pm "RTN","SDWLRAD",2,0) ;;5.3;scheduling;**263,645**;AUG 13 1993;Build 7 "RTN","SDWLRAD",3,0) ; "RTN","SDWLRAD",4,0) ; "RTN","SDWLRAD",5,0) ;****************************************************************** "RTN","SDWLRAD",6,0) ; CHANGE LOG "RTN","SDWLRAD",7,0) ; "RTN","SDWLRAD",8,0) ; DATE PATCH DESCRIPTION "RTN","SDWLRAD",9,0) ; ---- ----- ----------- "RTN","SDWLRAD",10,0) ; "RTN","SDWLRAD",11,0) ; "RTN","SDWLRAD",12,0) ; "RTN","SDWLRAD",13,0) ; "RTN","SDWLRAD",14,0) EN ;Header "RTN","SDWLRAD",15,0) D HD "RTN","SDWLRAD",16,0) S SDWLINST="",SDWLE=0 K ^TMP("SDWLRAD",$J),DIC,DIR,DR,DIE "RTN","SDWLRAD",17,0) D INS "RTN","SDWLRAD",18,0) D DATE G INS:E "RTN","SDWLRAD",19,0) D CAT G DATE:E "RTN","SDWLRAD",20,0) D PRI G CAT:E "RTN","SDWLRAD",21,0) D OPEN G PRI:E "RTN","SDWLRAD",22,0) D FORM G OPEN:E "RTN","SDWLRAD",23,0) D DIS "RTN","SDWLRAD",24,0) I E D QUE "RTN","SDWLRAD",25,0) Q "RTN","SDWLRAD",26,0) INS ;Get Institution "RTN","SDWLRAD",27,0) W !! S DIC(0)="QEMA",DIC("A")="Select Institution ALL // ",DIC=4,DIC("S")="I $D(^SDWL(409.32,""C"",+Y))" D ^DIC I Y<0,'SDWLE S Y="ALL" "RTN","SDWLRAD",28,0) G INS:Y<0,END:$D(DUOUT) "RTN","SDWLRAD",29,0) I Y="All"!(Y="")!(Y="all")!(Y="ALL") D "RTN","SDWLRAD",30,0) .S SDWLINST="ALL",SDWLE=1 S ^TMP("SDWLRAD",$J,"INS","ALL")="" "RTN","SDWLRAD",31,0) I 'SDWLE S SDWLERR=1,^TMP("SDWLRAD",$J,"INS",Y)="" G INS "RTN","SDWLRAD",32,0) Q "RTN","SDWLRAD",33,0) DATE ;Date range selection "RTN","SDWLRAD",34,0) S SDWLERR=0 W ! S %DT="AE",%DT("A")="Beginning Date: " D ^%DT G E1:Y<1 S SDWLBDT=Y "RTN","SDWLRAD",35,0) S %DT(0)=SDWLBDT,%DT("A")="Ending Date: " D ^%DT G DATE:Y<1 S SDWLEDT=Y K %DT(0),%DT("A") "RTN","SDWLRAD",36,0) I SDWLEDT49 S SDWLSCC=1 "RTN","SDWLROF",54,0) ..S ^TMP("SDWLROF",$J,+$P(SDWLX,U,3),SDWLTYPE,SDWLSCC,SDWLDA)="" "RTN","SDWLROF",55,0) ..S SDWLCNT=SDWLCNT+1,^TMP("SDWLROF",$J,+$P(SDWLX,U,3))=SDWLCNT "RTN","SDWLROF",56,0) Q "RTN","SDWLROF",57,0) PRINT ;Print Report "RTN","SDWLROF",58,0) D HD S SDWLCNT=0 I '$D(^TMP("SDWLROF",$J)) W !!,?80-$L("*** No Patient Records to Report ***")\2,"*** No Patient Records to Report ***" Q "RTN","SDWLROF",59,0) S SDWLA="" F S SDWLA=$O(^TMP("SDWLROF",$J,SDWLA)) G END:$$S^%ZTLOAD Q:SDWLA="" D Q:$D(DUOUT) "RTN","SDWLROF",60,0) .D LINE W !!,"Institution: " S X=$$EXTERNAL^DILFD(409.3,2,,SDWLA) W X I '$G(^TMP("SDWLROF",$J,SDWLA)) W !!,"*** No Patient Records to Report ***" "RTN","SDWLROF",61,0) .S SDWLB="" F S SDWLB=$O(^TMP("SDWLROF",$J,SDWLA,SDWLB)) Q:SDWLB="" D Q:$D(DUOUT) "RTN","SDWLROF",62,0) ..W !!,"Clinic/Service: " S X=$$EXTERNAL^DILFD(409.3,SDWLTXP,,SDWLB) W X,! Q:$D(DUOUT) "RTN","SDWLROF",63,0) ..S SDWLC="" F S SDWLC=$O(^TMP("SDWLROF",$J,SDWLA,SDWLB,SDWLC)) Q:SDWLC="" D Q:$D(DUOUT) "RTN","SDWLROF",64,0) ...S SDWLD="" F S SDWLD=$O(^TMP("SDWLROF",$J,SDWLA,SDWLB,SDWLC,SDWLD)) Q:SDWLD="" D Q:$D(DUOUT) "RTN","SDWLROF",65,0) ....S (DFN,SDWLDFN)=$P($G(^SDWL(409.3,SDWLD,0)),U,1) D 1^VADPT,DEM^VADPT,ELIG^VADPT,ADD^VADPT "RTN","SDWLROF",66,0) ....S SDWLELIG=$P(VAEL(1),U,2) "RTN","SDWLROF",67,0) ....S SDWLNAM=VADM(1),SDWLSSN=VA("BID") "RTN","SDWLROF",68,0) ....S SDWLDEAD=1 "RTN","SDWLROF",69,0) ....S SDWLAPTD=$P(^SDWL(409.3,SDWLD,0),U,16),SDWLCOM=$P(^SDWL(409.3,SDWLD,0),U,18) "RTN","SDWLROF",70,0) ....S SDWLRBY=$P(^SDWL(409.3,SDWLD,0),U,12),SDWLRPV=$P(^SDWL(409.3,SDWLD,0),U,13) "RTN","SDWLROF",71,0) ....S SDWLPH=$G(VAPA(8)) "RTN","SDWLROF",72,0) ....I SDWLAPTD'="" S Y=SDWLAPTD D DD^%DT S SDWLAPTD=Y "RTN","SDWLROF",73,0) ....W !!,SDWLNAM "RTN","SDWLROF",74,0) ....; SD*5.3*645 - replaced 'Desired Date' with 'CID/Preferred Date' "RTN","SDWLROF",75,0) ....;W ?35,SDWLSSN I SDWLAPTD'="" W ?50,"Desired Date: ",SDWLAPTD "RTN","SDWLROF",76,0) ....W ?35,SDWLSSN I SDWLAPTD'="" W ?48,"CID/Preferred Date: ",SDWLAPTD "RTN","SDWLROF",77,0) ....W !,"Primary Eligibility: ",SDWLELIG "RTN","SDWLROF",78,0) ....W !,"Comments: ",SDWLCOM,! "RTN","SDWLROF",79,0) ....I SDWLRBY W !,"Requested by: ",$$EXTERNAL^DILFD(409.3,11,,SDWLRBY) "RTN","SDWLROF",80,0) ....I SDWLRPV W ?35,"Requesting Provider: " S X=$$EXTERNAL^DILFD(409.3,12,,SDWLRPV) W X "RTN","SDWLROF",81,0) ....W !,"Telephone (Home): ",$P(SDWLPH,U,1) I $P(SDWLPH,U,2) W !,?10,"(Work): ",$P(SDWLPH,U,2) "RTN","SDWLROF",82,0) ....W !,"*****" "RTN","SDWLROF",83,0) ....I $D(SDWLSPT) S DIR(0)="E" D ^DIR I X["^" S DUOUT=1 Q "RTN","SDWLROF",84,0) ....I '$D(SDWLSPT),'$D(DUOUT),$Y>(IOSL-5) D HD "RTN","SDWLROF",85,0) ....K VAEL,VADM,VA,VAPA "RTN","SDWLROF",86,0) W !!,"** End of Report **" "RTN","SDWLROF",87,0) Q "RTN","SDWLROF",88,0) LINE ;Draw Line "RTN","SDWLROF",89,0) W !,"_______________________________________________________________________________" "RTN","SDWLROF",90,0) Q "RTN","SDWLROF",91,0) HD ;Header "RTN","SDWLROF",92,0) W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appt Wait List Overdue Report")\2,"Appt Wait List Overdue Report" "RTN","SDWLROF",93,0) S Y=DT D DD^%DT S SDWLPD=Y W ?57,SDWLPD S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG "RTN","SDWLROF",94,0) W !!,?30,"Institution: " I SDWLINS="ALL" D "RTN","SDWLROF",95,0) .W ?45,SDWLINS "RTN","SDWLROF",96,0) F I=1:1 S X=$P($P(SDWLINS,";",I),"^",2) Q:X="" W:I>1 ! W ?45,X "RTN","SDWLROF",97,0) S X=$P(SDWLCT2,U,2) "RTN","SDWLROF",98,0) W !?26,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL" "RTN","SDWLROF",99,0) I X'="ALL" D "RTN","SDWLROF",100,0) .F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$$EXTERNAL^DILFD(SDWLF,.01,,X) "RTN","SDWLROF",101,0) S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed") "RTN","SDWLROF",102,0) Q "RTN","SDWLROF",103,0) END K SDWL,SDWLA,SDWLAPTD,SDWLB,SDWLBD,SDWLBDT,SDWLC,SDWLCAT,SDWLCNT,SDWLCOM,SDWLCT1,SDWLCT2,SDWLCTX,SDWLD "RTN","SDWLROF",104,0) K SDLWDA,SDLWDEAD,SDWLDFN,SDWLE,SDWLEDT,SDWLELIG,SDWLERR,SDWLF,SDWLFD,SDWLI,SDWLIN,SDWLINS,SDWLINST "RTN","SDWLROF",105,0) K SDWLNAM,SDWLPD,SDWLPG,SDWLPH,SDWLPROM,SDWLRBY,SDWLPRV,SDWLSCC,SDWLSPT,SDWLSSN,SDWLTAG,SDLTK,SDWLTXP "RTN","SDWLROF",106,0) K SDWLTYP,SDWLTYPE,SDWLX,CT1,CT2,DATE,I,INS,OPEN,FORM "RTN","SDWLROF",107,0) Q "RTN","SDWLROS") 0^16^B32624484^B33019881 "RTN","SDWLROS",1,0) SDWLROS ;IOFO BAY PINES/TEH - WAIT LIST OVERDUE REPORT-SUMMARY ;1/5/16 9:25am "RTN","SDWLROS",2,0) ;;5.3;scheduling;**263,414,645**;AUG 13 1993;Build 7 "RTN","SDWLROS",3,0) ; "RTN","SDWLROS",4,0) ; "RTN","SDWLROS",5,0) ;****************************************************************** "RTN","SDWLROS",6,0) ; CHANGE LOG "RTN","SDWLROS",7,0) ; "RTN","SDWLROS",8,0) ; DATE PATCH DESCRIPTION "RTN","SDWLROS",9,0) ; ---- ----- ----------- "RTN","SDWLROS",10,0) ; "RTN","SDWLROS",11,0) ; "RTN","SDWLROS",12,0) ; "RTN","SDWLROS",13,0) ; "RTN","SDWLROS",14,0) EN ; "RTN","SDWLROS",15,0) D INIT "RTN","SDWLROS",16,0) I $$S^%ZTLOAD G END "RTN","SDWLROS",17,0) D HD "RTN","SDWLROS",18,0) D SORT "RTN","SDWLROS",19,0) I $$S^%ZTLOAD G END "RTN","SDWLROS",20,0) D PRT "RTN","SDWLROS",21,0) I $$S^%ZTLOAD G END "RTN","SDWLROS",22,0) D PRT1 "RTN","SDWLROS",23,0) K ^TMP("SDWLROS",$J) "RTN","SDWLROS",24,0) Q "RTN","SDWLROS",25,0) INIT ;Initialize variables "RTN","SDWLROS",26,0) ; "RTN","SDWLROS",27,0) I $D(CT1) S SDWLCT1=CT1 "RTN","SDWLROS",28,0) I $D(CT2) S SDWLCT2=CT2 "RTN","SDWLROS",29,0) I $D(FORM) S SDWLFORM=FORM "RTN","SDWLROS",30,0) I $D(INS) S SDWLINS=INS "RTN","SDWLROS",31,0) S SDWLPG=0 "RTN","SDWLROS",32,0) I $D(ZTSAVE) D "RTN","SDWLROS",33,0) .F SDWLI="CT1","CT2","FORM","INS" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI)) "RTN","SDWLROS",34,0) I SDWLINS="ALL" S SDWLIN("ALL")="" "RTN","SDWLROS",35,0) S SDWLTXP=$P(SDWLCT1,U,3),SDWLF=$P(SDWLCT1,U,2) "RTN","SDWLROS",36,0) I SDWLINS'="ALL" F SDWLI=1:1 S SDWLIN=$P($P(SDWLINS,";",SDWLI),U,1) Q:SDWLIN="" S SDWLIN(SDWLIN)="" "RTN","SDWLROS",37,0) I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCL=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCL="" S SDWLCT2(SDWLCL)="" "RTN","SDWLROS",38,0) D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=Y "RTN","SDWLROS",39,0) Q "RTN","SDWLROS",40,0) SORT ;Sort Records "RTN","SDWLROS",41,0) K ^TMP("SDWLROS",$J) "RTN","SDWLROS",42,0) S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D "RTN","SDWLROS",43,0) .S SDWLX=$G(^SDWL(409.3,SDWLDA,0)),SDWLERR=0,SDWLDFN=+SDWLX I 'SDWLDFN Q "RTN","SDWLROS",44,0) .;-Check for Institution Sort "RTN","SDWLROS",45,0) .I SDWLINS'="ALL" D "RTN","SDWLROS",46,0) ..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q "RTN","SDWLROS",47,0) .I $P(SDWLX,U,16)'49 S SDWLSCC=1 "RTN","SDWLROS",57,0) ..S:'$D(^TMP("SDWLROS",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)) ^(SDWLTYPE)=0 "RTN","SDWLROS",58,0) ..S ^TMP("SDWLROS",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1 "RTN","SDWLROS",59,0) ..S:'$D(^TMP("SDWLROS",$J,"B",+$P(SDWLX,U,3),SDWLTYPE,SDWLDFN)) ^(SDWLDFN)=0 S ^TMP("SDWLROS",$J,"B",+$P(SDWLX,U,3),SDWLTYPE,SDWLDFN)=^(SDWLDFN)+1 "RTN","SDWLROS",60,0) ..S:'$D(^TMP("SDWLROS",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)) ^TMP("SDWLROS",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=0 "RTN","SDWLROS",61,0) ..S ^TMP("SDWLROS",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1 "RTN","SDWLROS",62,0) ..S ^TMP("SDWLROS",$J,"D",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE,SDWLDWT,SDWLDA)="" "RTN","SDWLROS",63,0) Q "RTN","SDWLROS",64,0) PRT ; "RTN","SDWLROS",65,0) S SDWLIN=0 F S SDWLIN=$O(^TMP("SDWLROS",$J,"A",SDWLIN)) Q:SDWLIN="" W !,"Institution: ",$P($G(^DIC(4,SDWLIN,0)),U,1),! D "RTN","SDWLROS",66,0) .D PRA "RTN","SDWLROS",67,0) Q "RTN","SDWLROS",68,0) PRA ; "RTN","SDWLROS",69,0) S SDWLSC=0,(SDWLX,SDWLXT,SDWLXTT)=0 F S SDWLSC=$O(^TMP("SDWLROS",$J,"A",SDWLIN,SDWLSC)) Q:SDWLSC="" D "RTN","SDWLROS",70,0) .S SDWLX=$G(^TMP("SDWLROS",$J,"A",SDWLIN,SDWLSC)),SDWLXT=SDWLXT+SDWLX W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1)),?30,SDWLX "RTN","SDWLROS",71,0) .S SDWLDFNX=0 F S SDWLDFNX=$O(^TMP("SDWLROS",$J,"B",SDWLIN,SDWLSC,SDWLDFNX)) Q:SDWLDFNX="" S SDWLXTT=SDWLXTT+1 "RTN","SDWLROS",72,0) W !,?20,"Total #: ",SDWLXT "RTN","SDWLROS",73,0) ;W !,?4,"Total # Unique Patients: ",SDWLXTT,!! "RTN","SDWLROS",74,0) I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR I X="^" Q "RTN","SDWLROS",75,0) Q "RTN","SDWLROS",76,0) PRT1 ; "RTN","SDWLROS",77,0) D HD,HD1 "RTN","SDWLROS",78,0) S SDWLSCC=0 F S SDWLSCC=$O(^TMP("SDWLROS",$J,"D",SDWLSCC)) Q:SDWLSCC="" Q:$$S^%ZTLOAD D I $D(DUOUT) Q "RTN","SDWLROS",79,0) .W !,"******* ",SDWLSCC," *******",! "RTN","SDWLROS",80,0) .S SDWLINS=0 F S SDWLINS=$O(^TMP("SDWLROS",$J,"D",SDWLSCC,SDWLINS)) Q:SDWLINS="" D W ! I $D(DUOUT) Q "RTN","SDWLROS",81,0) ..W !,$P($G(^DIC(4,SDWLINS,0)),U,1),! "RTN","SDWLROS",82,0) ..S SDWLSC=0 F S SDWLSC=$O(^TMP("SDWLROS",$J,"D",SDWLSCC,SDWLINS,SDWLSC)) Q:SDWLSC="" D I $D(DUOUT) Q "RTN","SDWLROS",83,0) ...W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1)) "RTN","SDWLROS",84,0) ...S SDWLWT="" F S SDWLWT=$O(^TMP("SDWLROS",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT)) Q:SDWLWT="" D I $D(DUOUT) Q "RTN","SDWLROS",85,0) ....S SDWLDA=0 F S SDWLDA=$O(^TMP("SDWLROS",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT,SDWLDA)) Q:SDWLDA="" D I $D(DUOUT) Q "RTN","SDWLROS",86,0) .....S X=$G(^SDWL(409.3,SDWLDA,0)),SDWLODT=$P(X,U,2),SDWLDDT=$P(X,U,16) D "RTN","SDWLROS",87,0) ......S DFN=+X D 1^VADPT,DEM^VADPT "RTN","SDWLROS",88,0) ......W !,VA("BID"),?6,$E(VADM(1),1,25),?32,$E(SDWLODT,4,5),"/",$E(SDWLODT,6,7),"/",($E(SDWLODT,1,3)+1700) "RTN","SDWLROS",89,0) ......W ?47,$E(SDWLDDT,4,5),"/",$E(SDWLDDT,6,7),"/",($E(SDWLDDT,1,3)+1700),?60,$J(SDWLWT,5) K VA,VADM "RTN","SDWLROS",90,0) ......I $D(SDWLSPT),$Y>(IOSL+3) S DIR(0)="E" D ^DIR I X="^" S DUOUT=1 Q "RTN","SDWLROS",91,0) ......I $Y>(IOSL+3) D HD,HD1 "RTN","SDWLROS",92,0) .W ! "RTN","SDWLROS",93,0) Q "RTN","SDWLROS",94,0) LINE ;Draw Line "RTN","SDWLROS",95,0) W !,"_______________________________________________________________________________" "RTN","SDWLROS",96,0) Q "RTN","SDWLROS",97,0) HD ;Header "RTN","SDWLROS",98,0) W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appointment Wait List Overdue Report")\2,"Appointment Wait List Overdue Report" "RTN","SDWLROS",99,0) S Y=DT D DD^%DT S SDWLPD=Y W ?59,SDWLPD S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG "RTN","SDWLROS",100,0) W !!,?30,"Institution: " I SDWLINS="ALL" D "RTN","SDWLROS",101,0) .W ?45,SDWLINS "RTN","SDWLROS",102,0) F I=1:1 S X=$P($P(SDWLINS,";",I),"^",2) Q:X="" W:I>1 ! W ?45,X "RTN","SDWLROS",103,0) S X=$P(SDWLCT1,U,1) "RTN","SDWLROS",104,0) W !?27,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL" "RTN","SDWLROS",105,0) I X'="ALL" D "RTN","SDWLROS",106,0) .F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$$EXTERNAL^DILFD(SDWLF,.01,,X) "RTN","SDWLROS",107,0) S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed") "RTN","SDWLROS",108,0) Q "RTN","SDWLROS",109,0) HD1 ; "RTN","SDWLROS",110,0) ; SD*5.3*645 - changed 'Date Desired' to 'CID/PD' due to space limit "RTN","SDWLROS",111,0) ;W !!,"Name",?30,"Date Entered",?45,"Date Desired",?60,"# of Days Waiting",!! "RTN","SDWLROS",112,0) W !!,"Name",?30,"Date Entered",?47,"CID/PD",?60,"# of Days Waiting",!! "RTN","SDWLROS",113,0) Q "RTN","SDWLROS",114,0) END K X1,X2,SDWLAPDT,CT,CT1,CT2,I,OPEN,INS,FORM,VADM Q "RTN","SDWLRPS1") 0^21^B41748823^B42004976 "RTN","SDWLRPS1",1,0) SDWLRPS1 ;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1-SUMMARY ;1/5/16 3:40pm "RTN","SDWLRPS1",2,0) ;;5.3;scheduling;**263,412,645**;AUG 13 1993;Build 7 "RTN","SDWLRPS1",3,0) ; "RTN","SDWLRPS1",4,0) ; "RTN","SDWLRPS1",5,0) ;****************************************************************** "RTN","SDWLRPS1",6,0) ; CHANGE LOG "RTN","SDWLRPS1",7,0) ; "RTN","SDWLRPS1",8,0) ; DATE PATCH DESCRIPTION "RTN","SDWLRPS1",9,0) ; ---- ----- ----------- "RTN","SDWLRPS1",10,0) ; "RTN","SDWLRPS1",11,0) ; "RTN","SDWLRPS1",12,0) ; "RTN","SDWLRPS1",13,0) ; "RTN","SDWLRPS1",14,0) EN ; "RTN","SDWLRPS1",15,0) D INIT "RTN","SDWLRPS1",16,0) I $$S^%ZTLOAD G END "RTN","SDWLRPS1",17,0) D HD "RTN","SDWLRPS1",18,0) D SORT "RTN","SDWLRPS1",19,0) I $$S^%ZTLOAD G END "RTN","SDWLRPS1",20,0) D PRT "RTN","SDWLRPS1",21,0) I $D(DUOUT) W !!,"*** End of Report ***" G END "RTN","SDWLRPS1",22,0) G:POP END "RTN","SDWLRPS1",23,0) I $$S^%ZTLOAD G END "RTN","SDWLRPS1",24,0) D PRT1 "RTN","SDWLRPS1",25,0) W !!,"*** End of Report ***" "RTN","SDWLRPS1",26,0) K ^TMP("SDWLRPS1",$J) "RTN","SDWLRPS1",27,0) Q "RTN","SDWLRPS1",28,0) INIT ;Initialize variables "RTN","SDWLRPS1",29,0) ; "RTN","SDWLRPS1",30,0) I $D(CT1) S SDWLCT1=CT1 "RTN","SDWLRPS1",31,0) I $D(CT2) S SDWLCT2=CT2 "RTN","SDWLRPS1",32,0) I $D(DATE) S SDWLDATE=DATE "RTN","SDWLRPS1",33,0) I $D(FORM) S SDWLFORM=FORM "RTN","SDWLRPS1",34,0) I $D(INS) S SDWLINS=INS "RTN","SDWLRPS1",35,0) I $D(OPEN) S SDWLOPEN=OPEN "RTN","SDWLRPS1",36,0) S SDWLPG=0 "RTN","SDWLRPS1",37,0) I $D(ZTSAVE) D "RTN","SDWLRPS1",38,0) .F SDWLI="CT1","CT2","DATE","FORM","INS","OPEN" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI)) "RTN","SDWLRPS1",39,0) I SDWLINS="ALL" S SDWLIN("ALL")="" "RTN","SDWLRPS1",40,0) S SDWLTXP=$P(SDWLCT1,U,3) "RTN","SDWLRPS1",41,0) S SDWLOPEN=$S(SDWLOPEN=1:"O",1:"C") "RTN","SDWLRPS1",42,0) I SDWLINS'="ALL" F SDWLI=1:1 S SDWLIN=$P($P(SDWLINS,";",SDWLI),U,1) Q:SDWLIN="" S SDWLIN(SDWLIN)="",^TMP("SDWLRPT1",$J,$P(^DIC(4,SDWLIN,0),U,1))=0 "RTN","SDWLRPS1",43,0) I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCT=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCT="" S SDWLCT2(SDWLCT)="" "RTN","SDWLRPS1",44,0) I SDWLDATE="ALL" S SDWLBD=0,SDWLED=9999999 G INIT1 "RTN","SDWLRPS1",45,0) S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2) "RTN","SDWLRPS1",46,0) N POP S POP=0 ;SD*5.3*412 "RTN","SDWLRPS1",47,0) INIT1 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2) "RTN","SDWLRPS1",48,0) Q "RTN","SDWLRPS1",49,0) SORT ;Sort Records "RTN","SDWLRPS1",50,0) K ^TMP("SDWLRPS1",$J) "RTN","SDWLRPS1",51,0) S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D "RTN","SDWLRPS1",52,0) .S SDWLX=$G(^SDWL(409.3,SDWLDA,0)),SDWLERR=0,SDWLDFN=+SDWLX,SDWLDDT=$P(SDWLX,U,16) "RTN","SDWLRPS1",53,0) .;-Check for Institution Sort "RTN","SDWLRPS1",54,0) .I SDWLINS'="ALL" D "RTN","SDWLRPS1",55,0) ..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q "RTN","SDWLRPS1",56,0) .;-Check for Date Range Compliance "RTN","SDWLRPS1",57,0) .I $P(SDWLX,U,16)SDWLED) S SDWLERR=2 Q "RTN","SDWLRPS1",58,0) .S SDWLAPDT=$P(SDWLX,U,16),SDWLOPDT=$P(SDWLX,U,2) S X1=DT,X2=SDWLAPDT D ^%DTC S SDWLDWT=X I SDWLDWT<0 S SDWLDWT=0 "RTN","SDWLRPS1",59,0) .S SDWLTYP=$P(SDWLCT1,U,1),SDWLTYPE=$S(SDWLTYP="C":$P(SDWLX,U,9),1:$P(SDWLX,U,8)) I SDWLTYPE="" S SDWLERR=7 Q "RTN","SDWLRPS1",60,0) .S SDWLF=$P(SDWLCT1,U,2) "RTN","SDWLRPS1",61,0) .I SDWLCT2'="ALL" D "RTN","SDWLRPS1",62,0) ..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3 "RTN","SDWLRPS1",63,0) .I SDWLTYP="" S SDWLERR=4 Q "RTN","SDWLRPS1",64,0) .I SDWLOPEN'["C",$P(SDWLX,U,17)'[SDWLOPEN S SDWLERR=6 Q "RTN","SDWLRPS1",65,0) .Q:SDWLERR D "RTN","SDWLRPS1",66,0) ..S SDWLSCC=2,DFN=SDWLDFN D ELIG^VADPT I $D(VAEL(3)) S SDWLSCN=$P(VAEL(3),U,2) I SDWLSCN>49 S SDWLSCC=1 "RTN","SDWLRPS1",67,0) ..S:'$D(^TMP("SDWLRPS1",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)) ^(SDWLTYPE)=0 "RTN","SDWLRPS1",68,0) ..S ^TMP("SDWLRPS1",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1 "RTN","SDWLRPS1",69,0) ..S:'$D(^TMP("SDWLRPS1",$J,"B",+$P(SDWLX,U,3),SDWLTYPE,SDWLDFN)) ^(SDWLDFN)=0 S ^TMP("SDWLRPS1",$J,"B",+$P(SDWLX,U,3),SDWLTYPE,SDWLDFN)=^(SDWLDFN)+1 "RTN","SDWLRPS1",70,0) ..S:'$D(^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)) ^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=0 "RTN","SDWLRPS1",71,0) ..S ^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1 "RTN","SDWLRPS1",72,0) ..S ^TMP("SDWLRPS1",$J,"D",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE,+SDWLDWT,SDWLDA)="" "RTN","SDWLRPS1",73,0) Q "RTN","SDWLRPS1",74,0) PRT ; "RTN","SDWLRPS1",75,0) I '$D(^TMP("SDWLRPS1",$J,"A")) W !!,"*** No Patients to Report ***" S DUOUT="" Q "RTN","SDWLRPS1",76,0) S SDWLIN=0 F S SDWLIN=$O(^TMP("SDWLRPS1",$J,"A",SDWLIN)) Q:SDWLIN="" W !,"Institution: ",$P($G(^DIC(4,SDWLIN,0)),U,1),! D Q:POP ;SD*5.3*412 "RTN","SDWLRPS1",77,0) .D PRA "RTN","SDWLRPS1",78,0) Q "RTN","SDWLRPS1",79,0) PRA ; "RTN","SDWLRPS1",80,0) S SDWLSC=0,(SDWLX,SDWLXT)=0 F S SDWLSC=$O(^TMP("SDWLRPS1",$J,"A",SDWLIN,SDWLSC)) Q:SDWLSC="" D "RTN","SDWLRPS1",81,0) .S SDWLX=$G(^TMP("SDWLRPS1",$J,"A",SDWLIN,SDWLSC)),SDWLXT=SDWLXT+SDWLX W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1)),?30,SDWLX "RTN","SDWLRPS1",82,0) .S SDWLXTT=0,SDWLDFNX=0 F S SDWLDFNX=$O(^TMP("SDWLRPS1",$J,"B",SDWLIN,SDWLSC,SDWLDFNX)) Q:SDWLDFNX="" S SDWLXTT=SDWLXTT+1 "RTN","SDWLRPS1",83,0) W !,?20,"Total #: ",SDWLXT "RTN","SDWLRPS1",84,0) I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR S:X="^" POP=1 Q:POP ;SD*5.3*412 early exit "RTN","SDWLRPS1",85,0) Q "RTN","SDWLRPS1",86,0) PRT1 ; "RTN","SDWLRPS1",87,0) N DFN "RTN","SDWLRPS1",88,0) D HD1 "RTN","SDWLRPS1",89,0) S SDWLSCC=0 F S SDWLSCC=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC)) Q:SDWLSCC="" Q:$$S^%ZTLOAD D Q:POP ;SD*5.3*412 added to allow early exit "RTN","SDWLRPS1",90,0) .W !,"******* ",SDWLSCC," *******",! "RTN","SDWLRPS1",91,0) .S SDWLINS=0 F S SDWLINS=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS)) Q:SDWLINS="" D Q:POP W ! ;SD*5.3*412 "RTN","SDWLRPS1",92,0) ..W !,$P($G(^DIC(4,SDWLINS,0)),U,1) "RTN","SDWLRPS1",93,0) ..S SDWLSC=0 F S SDWLSC=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC)) Q:SDWLSC="" D Q:POP ;SD*5.3*412 "RTN","SDWLRPS1",94,0) ...W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1)) "RTN","SDWLRPS1",95,0) ...S SDWLWT="" F S SDWLWT=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT)) Q:SDWLWT="" D Q:POP ;SD*5.3*412 "RTN","SDWLRPS1",96,0) ....S SDWLDA=0 F S SDWLDA=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT,SDWLDA)) Q:SDWLDA="" D Q:POP ;SD*5.3*412 "RTN","SDWLRPS1",97,0) .....S X=$G(^SDWL(409.3,SDWLDA,0)),SDWLODT=$P(X,U,2),SDWLDDT=$P(X,U,16) S DFN=+X D Q:POP ;SD*5.3*412 "RTN","SDWLRPS1",98,0) ......D DEM^VADPT,1^VADPT K DFN "RTN","SDWLRPS1",99,0) ......W !,VA("BID"),?6,$E(VADM(1),1,25) W ?32,$E(SDWLODT,4,5),"/",$E(SDWLODT,6,7),"/",($E(SDWLODT,1,3)+1700) "RTN","SDWLRPS1",100,0) ......W ?47,$E(SDWLDDT,4,5),"/",$E(SDWLDDT,6,7),"/",($E(SDWLDDT,1,3)+1700),?60,$J(SDWLWT,5) "RTN","SDWLRPS1",101,0) ......I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR S:X="^" POP=1 Q:POP D HD1 "RTN","SDWLRPS1",102,0) ......I $Y>IOSL D HD "RTN","SDWLRPS1",103,0) .W ! "RTN","SDWLRPS1",104,0) LINE ;Draw Line "RTN","SDWLRPS1",105,0) W !,"_______________________________________________________________________________" "RTN","SDWLRPS1",106,0) Q "RTN","SDWLRPS1",107,0) HD ;Header "RTN","SDWLRPS1",108,0) W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report" "RTN","SDWLRPS1",109,0) S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG "RTN","SDWLRPS1",110,0) W !!,?30,"Institution: " I SDWLINS="ALL" D "RTN","SDWLRPS1",111,0) .W ?45,SDWLINS "RTN","SDWLRPS1",112,0) F I=1:1 S X=$P($P(SDWLINS,";",I),"^",2) Q:X="" W:I>1 ! W ?45,X "RTN","SDWLRPS1",113,0) S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBDT=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLEDT=Y "RTN","SDWLRPS1",114,0) ; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date' "RTN","SDWLRPS1",115,0) ;W !,?23,"Date Desired Range: ",SDWLBDT," to ",SDWLEDT "RTN","SDWLRPS1",116,0) W !,?18,"CID/Preferred Date Range: ",SDWLBDT," to ",SDWLEDT "RTN","SDWLRPS1",117,0) S X=$P(SDWLCT2,U,2) "RTN","SDWLRPS1",118,0) W !?27,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL" "RTN","SDWLRPS1",119,0) I X'="ALL" D "RTN","SDWLRPS1",120,0) .F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$$EXTERNAL^DILFD(SDWLF,.01,,X) "RTN","SDWLRPS1",121,0) S X=$G(SDWLOPEN) W !,?36,"Status: ",$S(SDWLOPEN="O":"Open",1:"All") "RTN","SDWLRPS1",122,0) S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed") "RTN","SDWLRPS1",123,0) W ! "RTN","SDWLRPS1",124,0) Q "RTN","SDWLRPS1",125,0) HD1 ; "RTN","SDWLRPS1",126,0) W:$D(IOF) @IOF "RTN","SDWLRPS1",127,0) ; SD*5.3*645 - replaced 'Date Desired' with 'CID/PD' and adjusted format "RTN","SDWLRPS1",128,0) ;W !!,"Name",?30,"Date Entered",?45,"Date Desired",?60,"# of Days Waiting",! "RTN","SDWLRPS1",129,0) W !!,"Name",?30,"Date Entered",?47,"CID/PD",?60,"# of Days Waiting",! "RTN","SDWLRPS1",130,0) END K X1,X2,CT1,CT2,DATE,I,INS,OPEN,FORM "RTN","SDWLRPS1",131,0) K ^TMP("SDWLRPT1",$J) Q "RTN","SDWLRPS1",132,0) ; "RTN","SDWLRPT1") 0^11^B45492477^B43599634 "RTN","SDWLRPT1",1,0) SDWLRPT1 ;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1 ;1/5/16 3:39pm "RTN","SDWLRPT1",2,0) ;;5.3;scheduling;**263,399,394,645**;AUG 13 1993;Build 7 "RTN","SDWLRPT1",3,0) ; "RTN","SDWLRPT1",4,0) ; "RTN","SDWLRPT1",5,0) ;****************************************************************** "RTN","SDWLRPT1",6,0) ; CHANGE LOG "RTN","SDWLRPT1",7,0) ; "RTN","SDWLRPT1",8,0) ; DATE PATCH DESCRIPTION "RTN","SDWLRPT1",9,0) ; ---- ----- ----------- "RTN","SDWLRPT1",10,0) ; "RTN","SDWLRPT1",11,0) ; "RTN","SDWLRPT1",12,0) ; "RTN","SDWLRPT1",13,0) ; "RTN","SDWLRPT1",14,0) EN D INIT "RTN","SDWLRPT1",15,0) I $$S^%ZTLOAD G END "RTN","SDWLRPT1",16,0) D SORT "RTN","SDWLRPT1",17,0) I $$S^%ZTLOAD G END "RTN","SDWLRPT1",18,0) D PRINT "RTN","SDWLRPT1",19,0) I $$S^%ZTLOAD G END "RTN","SDWLRPT1",20,0) K ^TMP("SDWLRPT1",$J),^TMP("SDWLRQ1",$J) "RTN","SDWLRPT1",21,0) Q "RTN","SDWLRPT1",22,0) INIT ;Initialize variables "RTN","SDWLRPT1",23,0) ; "RTN","SDWLRPT1",24,0) I $D(CT1) S SDWLCT1=CT1 "RTN","SDWLRPT1",25,0) I $D(CT2) S SDWLCT2=CT2 "RTN","SDWLRPT1",26,0) I $D(DATE) S SDWLDATE=DATE "RTN","SDWLRPT1",27,0) I $D(FORM) S SDWLFORM=FORM "RTN","SDWLRPT1",28,0) I $D(INS) S SDWLINS=INS "RTN","SDWLRPT1",29,0) I $D(OPEN) S SDWLOPEN=OPEN "RTN","SDWLRPT1",30,0) S SDWLPG=0 "RTN","SDWLRPT1",31,0) I $D(ZTSAVE) D "RTN","SDWLRPT1",32,0) .F SDWLI="CT1","CT2","DATE","FORM","INS","OPEN" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI)) "RTN","SDWLRPT1",33,0) I SDWLINS="ALL" S SDWLIN("ALL")="" "RTN","SDWLRPT1",34,0) S SDWLTXP=$P(SDWLCT1,U,3) "RTN","SDWLRPT1",35,0) S SDWLOPEN=$S(SDWLOPEN=1:"O",1:"C") "RTN","SDWLRPT1",36,0) I SDWLINS'="ALL" F SDWLI=1:1 S SDWLIN=$P($P(SDWLINS,";",SDWLI),U,1) Q:SDWLIN="" S SDWLIN(SDWLIN)="",^TMP("SDWLRPT1",$J,$P(^DIC(4,SDWLIN,0),U,1))=0 "RTN","SDWLRPT1",37,0) I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCT=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCT="" S SDWLCT2(SDWLCT)="" "RTN","SDWLRPT1",38,0) I SDWLDATE="ALL" S SDWLBD=0,SDWLED=9999999 G INIT1 "RTN","SDWLRPT1",39,0) S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2) "RTN","SDWLRPT1",40,0) INIT1 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2) "RTN","SDWLRPT1",41,0) Q "RTN","SDWLRPT1",42,0) SORT ;Sort Records "RTN","SDWLRPT1",43,0) S SDWLDA=0,SDWLCNT=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D "RTN","SDWLRPT1",44,0) .S SDWLX=$G(^SDWL(409.3,SDWLDA,0)),SDWLERR=0,SDWLDFN=+SDWLX "RTN","SDWLRPT1",45,0) .;-Check for Institution Sort "RTN","SDWLRPT1",46,0) .I SDWLINS'="ALL" D "RTN","SDWLRPT1",47,0) ..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q "RTN","SDWLRPT1",48,0) .;-Check for Date Range Compliance "RTN","SDWLRPT1",49,0) .I $P(SDWLX,U,16)SDWLED) S SDWLERR=2 Q "RTN","SDWLRPT1",50,0) .S SDWLTYP=$P(SDWLCT1,U,1),SDWLTYPE=$S(SDWLTYP="C":$P(SDWLX,U,9),1:$P(SDWLX,U,8)) I SDWLTYPE="" S SDWLERR=7 Q "RTN","SDWLRPT1",51,0) .I SDWLCT2'="ALL" D "RTN","SDWLRPT1",52,0) ..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3 "RTN","SDWLRPT1",53,0) .I SDWLTYP="" S SDWLERR=4 Q "RTN","SDWLRPT1",54,0) .I $P(SDWLX,U,3)=""!($P(SDWLX,U,16)="") S SDWLERR=5 Q "RTN","SDWLRPT1",55,0) .I SDWLOPEN'["C",$P(SDWLX,U,17)'[SDWLOPEN S SDWLERR=6 Q "RTN","SDWLRPT1",56,0) .Q:SDWLERR D "RTN","SDWLRPT1",57,0) ..S SDWLSCC=2,DFN=SDWLDFN D ELIG^VADPT I $D(VAEL(3)) S SDWLSCN=$P(VAEL(3),U,2) I SDWLSCN>49 S SDWLSCC=1 "RTN","SDWLRPT1",58,0) ..S SDWLF=$P(SDWLCT1,U,2) "RTN","SDWLRPT1",59,0) ..S SDWLIENS=$P(SDWLX,U,3)_",",X=$$GET1^DIQ(4,SDWLIENS,".01") "RTN","SDWLRPT1",60,0) ..S SDWLSIEN=SDWLTYPE_",",Y=$$GET1^DIQ(SDWLF,SDWLSIEN,".01") "RTN","SDWLRPT1",61,0) ..S ^TMP("SDWLRPT1",$J,X,Y,SDWLSCC,+$P(SDWLX,U,16),SDWLDA)="" "RTN","SDWLRPT1",62,0) ..S SDWLCNT=SDWLCNT+1,^TMP("SDWLRPT1",$J,$P(^DIC(4,+$P(SDWLX,U,3),0),U,1))=SDWLCNT "RTN","SDWLRPT1",63,0) Q "RTN","SDWLRPT1",64,0) PRINT ;Print Report "RTN","SDWLRPT1",65,0) N DFN "RTN","SDWLRPT1",66,0) D HD S SDWLCNT=0 I '$D(^TMP("SDWLRPT1",$J)) W !!,?80-$L("*** No Patient Records to Report ***")\2,"*** No Patient Records to Report ***" Q "RTN","SDWLRPT1",67,0) S SDWLA="" F S SDWLA=$O(^TMP("SDWLRPT1",$J,SDWLA)) G END:$$S^%ZTLOAD Q:SDWLA="" D Q:$D(DUOUT) "RTN","SDWLRPT1",68,0) .D LINE W !!,"Institution: " S X=SDWLA W X I '$G(^TMP("SDWLRPT1",$J,SDWLA)) W !!,"*** No Patient Records to Report ***" "RTN","SDWLRPT1",69,0) .S SDWLB="" F S SDWLB=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB)) Q:SDWLB="" D Q:$D(DUOUT) "RTN","SDWLRPT1",70,0) ..W !!,"Clinic/Service: " S X=SDWLB W X,! Q:$D(DUOUT) "RTN","SDWLRPT1",71,0) ..S SDWLC="" F S SDWLC=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC)) Q:SDWLC="" D Q:$D(DUOUT) "RTN","SDWLRPT1",72,0) ...S SDWLD="" F S SDWLD=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC,SDWLD)) Q:SDWLD="" D Q:$D(DUOUT) "RTN","SDWLRPT1",73,0) ....S SDWLE="" F S SDWLE=$O(^TMP("SDWLRPT1",$J,SDWLA,SDWLB,SDWLC,SDWLD,SDWLE)) Q:SDWLE="" D Q:$D(DUOUT) "RTN","SDWLRPT1",74,0) .....S SDWLDFN=$P($G(^SDWL(409.3,SDWLE,0)),U,1),DFN=SDWLDFN D DEM^VADPT,ELIG^VADPT,ADD^VADPT "RTN","SDWLRPT1",75,0) .....S SDWLNAM=VADM(1),SDWLELIG=VAEL(1) I SDWLELIG="" S SDWLELIG=0 "RTN","SDWLRPT1",76,0) .....I SDWLELIG=0 S SDWLELIG="No Eligibility Status found" "RTN","SDWLRPT1",77,0) .....S SDWLDEAD=1 "RTN","SDWLRPT1",78,0) .....S SDWLSSN=VA("BID"),SDWLAPTD=$P(^SDWL(409.3,SDWLE,0),U,16),SDWLCOM=$P(^SDWL(409.3,SDWLE,0),U,18) "RTN","SDWLRPT1",79,0) .....S SDWLRBY=$P(^SDWL(409.3,SDWLE,0),U,12),SDWLRPV=$P(^SDWL(409.3,SDWLE,0),U,13) "RTN","SDWLRPT1",80,0) .....S SDWLPH=$G(VAPA(8)) I SDWLAPTD'="" S Y=SDWLAPTD D DD^%DT S SDWLAPTD=Y "RTN","SDWLRPT1",81,0) .....W !!,SDWLNAM "RTN","SDWLRPT1",82,0) .....; SD*5.3*645 - replaced Desired Date with CID/Preferred Date when presented to the user "RTN","SDWLRPT1",83,0) .....;W ?35,SDWLSSN I SDWLAPTD'="" W ?50,"Desired Date: ",SDWLAPTD "RTN","SDWLRPT1",84,0) .....W ?35,SDWLSSN I SDWLAPTD'="" W ?48,"CID/Preferred Date: ",SDWLAPTD "RTN","SDWLRPT1",85,0) .....W !,"Primary Eligibility: ",$P(SDWLELIG,U,2) "RTN","SDWLRPT1",86,0) .....;PATCH SD*5.3*394 See Note. "RTN","SDWLRPT1",87,0) .....N SDWLSCP "RTN","SDWLRPT1",88,0) .....W !,"Service Connected Priority: " S SDWLSCP=$$GET1^DIQ(409.3,SDWLE_",",15,"I") W $S(SDWLSCP=1:"YES",1:"NO") "RTN","SDWLRPT1",89,0) .....W !,"Comments: ",SDWLCOM,! "RTN","SDWLRPT1",90,0) .....I SDWLRBY W !,"Requested by: ",$$EXTERNAL^DILFD(409.3,11,,SDWLRBY) "RTN","SDWLRPT1",91,0) .....I SDWLRPV W ?35,"Requesting Provider: " S X=$$EXTERNAL^DILFD(409.3,12,,SDWLRPV) W X "RTN","SDWLRPT1",92,0) .....W !,"Telephone (Home): ",$P(SDWLPH,U,1) I $P(SDWLPH,U,2) W !,?10,"(Work): ",$P(SDWLPH,U,2) "RTN","SDWLRPT1",93,0) .....I $D(^SDWL(409.3,SDWLE,"DIS")) D "RTN","SDWLRPT1",94,0) ......S SDWLDISX=$G(^SDWL(409.3,SDWLE,"DIS")),SDWLDIS=$P(SDWLDISX,U,3),SDWLDDUZ=$P(SDWLDISX,U,2) "RTN","SDWLRPT1",95,0) ......S SDWLDDT=$P(^SDWL(409.3,SDWLE,"DIS"),U,1),SDWLDIDT=$E(SDWLDDT,4,5)_"/"_$E(SDWLDDT,6,7)_"/"_$E(SDWLDDT,2,3) "RTN","SDWLRPT1",96,0) .....I $D(SDWLDISX) W !,"Disposition: ",$P(SDWLDISX,U,3)," (",SDWLDIDT,")" K SDWLDISX,SDWLDIS,SDWLDDUZ,SDWLDIDT "RTN","SDWLRPT1",97,0) .....W !,"*****" "RTN","SDWLRPT1",98,0) .....I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR I X["^" S DUOUT=1 Q "RTN","SDWLRPT1",99,0) .....I '$D(SDWLSPT),'$D(DUOUT),$Y>(IOSL-5) D HD "RTN","SDWLRPT1",100,0) W !!,"** End of Report **" "RTN","SDWLRPT1",101,0) Q "RTN","SDWLRPT1",102,0) LINE ;Draw Line "RTN","SDWLRPT1",103,0) W !,"_______________________________________________________________________________" "RTN","SDWLRPT1",104,0) Q "RTN","SDWLRPT1",105,0) HD ;Header "RTN","SDWLRPT1",106,0) W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report" "RTN","SDWLRPT1",107,0) S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG "RTN","SDWLRPT1",108,0) W !!,?30,"Institution: " I SDWLINS="ALL" D "RTN","SDWLRPT1",109,0) .W ?45,SDWLINS "RTN","SDWLRPT1",110,0) F I=1:1 S X=$P($P(SDWLINS,";",I),"^",2) Q:X="" W:I>1 ! W ?45,X "RTN","SDWLRPT1",111,0) S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBDT=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLEDT=Y "RTN","SDWLRPT1",112,0) ; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date', adjusted format "RTN","SDWLRPT1",113,0) ;W !,?23,"Date Desired Range: ",SDWLBDT "RTN","SDWLRPT1",114,0) W !,?17,"CID/Preferred Date Range: ",SDWLBDT "RTN","SDWLRPT1",115,0) I SDWLEDT'="" W " to ",SDWLEDT "RTN","SDWLRPT1",116,0) S X=$P(SDWLCT2,U,2) "RTN","SDWLRPT1",117,0) W !?26,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL" "RTN","SDWLRPT1",118,0) S SDWLF=$P(SDWLCT1,U,1) "RTN","SDWLRPT1",119,0) I X'="ALL" D "RTN","SDWLRPT1",120,0) .F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$S(SDWLF="C":$P(^SC(X,0),U,1),1:$P(^DIC(40.7,X,0),U,1)) "RTN","SDWLRPT1",121,0) S X=$G(SDWLOPEN) W !,?35,"Status: ",$S(SDWLOPEN="O":"Open",1:"All") "RTN","SDWLRPT1",122,0) S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed") "RTN","SDWLRPT1",123,0) Q "RTN","SDWLRPT1",124,0) END K SDWL,SDWLA,SDWLAPTD,SDWLB,SDWLBD,SDWLBDT,SDWLC,SDWLCAT,SDWLCNT,SDWLCOM,SDWLCT1,SDWLCT2,SDWLCTX,SDWLD "RTN","SDWLRPT1",125,0) K SDLWDA,SDLWDEAD,SDWLDFN,SDWLE,SDWLEDT,SDWLELIG,SDWLERR,SDWLF,SDWLFD,SDWLI,SDWLIN,SDWLINS,SDWLINST "RTN","SDWLRPT1",126,0) K SDWLNAM,SDWLPD,SDWLPG,SDWLPH,SDWLPROM,SDWLRBY,SDWLPRV,SDWLSCC,SDWLSPT,SDWLSSN,SDWLTAG,SDLTK,SDWLTXP "RTN","SDWLRPT1",127,0) K SDWLTYP,SDWLTYPE,SDWLX,VDAM,VAPA,SDWLIENS,CT1,CT2,DATE,I,INS,OPEN,FORM,SDWLSIEN "RTN","SDWLRPT1",128,0) D EN^SDWLKIL "RTN","SDWLRPT1",129,0) Q "RTN","SDWLRQ1") 0^17^B40571252^B39567538 "RTN","SDWLRQ1",1,0) SDWLRQ1 ;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT ;1/5/16 10:44am "RTN","SDWLRQ1",2,0) ;;5.3;scheduling;**263,399,412,425,448,645**;AUG 13 1993;Build 7 "RTN","SDWLRQ1",3,0) ; "RTN","SDWLRQ1",4,0) ; "RTN","SDWLRQ1",5,0) ;****************************************************************** "RTN","SDWLRQ1",6,0) ; CHANGE LOG "RTN","SDWLRQ1",7,0) ; "RTN","SDWLRQ1",8,0) ; DATE PATCH DESCRIPTION "RTN","SDWLRQ1",9,0) ; ---- ----- ----------- "RTN","SDWLRQ1",10,0) ; "RTN","SDWLRQ1",11,0) ; "RTN","SDWLRQ1",12,0) ; "RTN","SDWLRQ1",13,0) ; "RTN","SDWLRQ1",14,0) EN ;Header "RTN","SDWLRQ1",15,0) N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK "RTN","SDWLRQ1",16,0) D HD "RTN","SDWLRQ1",17,0) S SDWLINST="",SDWLERR=0 K ^TMP("SDWLRQ1",$J),DIC,DIR,DR,DIE "RTN","SDWLRQ1",18,0) 1 D INS G END:$D(DUOUT) "RTN","SDWLRQ1",19,0) 2 D CAT G 1:SDWLERR,2:$D(DUOUT) "RTN","SDWLRQ1",20,0) 3 D DATE G 2:SDWLERR,END:$D(DUOUT) "RTN","SDWLRQ1",21,0) 4 D OPEN G 3:SDWLERR,3:$D(DUOUT) "RTN","SDWLRQ1",22,0) 5 D FORM G 4:SDWLERR,4:$D(DUOUT) "RTN","SDWLRQ1",23,0) 6 D DIS G EN:SDWLERR=1,END:SDWLERR=2 "RTN","SDWLRQ1",24,0) D QUE "RTN","SDWLRQ1",25,0) Q "RTN","SDWLRQ1",26,0) INS ;Get Institution "RTN","SDWLRQ1",27,0) N SDWLINST S SDWLINST="" "RTN","SDWLRQ1",28,0) S SDWLERR=0,SDWLPROM="Select Institution ALL // " "RTN","SDWLRQ1",29,0) IN W ! S DIC(0)="QEMA",DIC("A")=SDWLPROM,DIC=4,DIC("S")="I $D(^SDWL(409.32,""C"",+Y))!($D(^SDWL(409.31,""E"",+Y)))!($D(^SCTM(404.51,""AINST"",+Y)))" D ^DIC I Y<0,'SDWLERR Q:$D(DUOUT) S Y="ALL" "RTN","SDWLRQ1",30,0) G IN2:Y<0 Q:$D(DUOUT) "RTN","SDWLRQ1",31,0) I Y<0 S SDWLINST=$S(Y="ALL":"ALL",Y="":"ALL",Y="all":"ALL",Y="All":"ALL",Y["A":"ALL",Y["a":"ALL") "RTN","SDWLRQ1",32,0) I Y="All"!(Y="")!(Y="all")!(Y="ALL") S SDWLINST="ALL",^TMP("SDWLRQ1",$J,"INS")="ALL" G IN3 "RTN","SDWLRQ1",33,0) S SDWLINST=SDWLINST_Y_";",SDWLPROM="Another Institution: ",SDWLERR=1 G IN "RTN","SDWLRQ1",34,0) IN2 S ^TMP("SDWLRQ1",$J,"INS")=SDWLINST "RTN","SDWLRQ1",35,0) IN3 Q "RTN","SDWLRQ1",36,0) CAT ;Report category selection "RTN","SDWLRQ1",37,0) K DIR,DIE,DR,DIC "RTN","SDWLRQ1",38,0) W !!," *** Report Category Selection ***" S SDWLERR=0 "RTN","SDWLRQ1",39,0) S SDWLERR=0,SDWLCAT="",DIR(0)="SO^1:Clinic;2:Select Service/Specialty",DIR("L",1)=" 1. Clinic",DIR("L")=" 2. Service/Specialty" "RTN","SDWLRQ1",40,0) D ^DIR "RTN","SDWLRQ1",41,0) I X="^" S SDWLERR=1 W *7 Q "RTN","SDWLRQ1",42,0) I X="" S SDWLERR=1 W *7 Q "RTN","SDWLRQ1",43,0) S X=$S(X["C":"C",X["c":"C",X["S":"S",X["s":"S",X=1:"C",X=2:"S",1:"") "RTN","SDWLRQ1",44,0) I X="" W *7," Invalid Selection." G CAT "RTN","SDWLRQ1",45,0) W !!,"Select Category for Report Output",! "RTN","SDWLRQ1",46,0) S SDWLX=$S(X="C":"Clinic: ALL// ",X="S":"Service/Specialty: ALL// ") "RTN","SDWLRQ1",47,0) S SDWLF=$S(X["C":409.32,X["S":409.31,X["c":409.32,X["s":409.31) "RTN","SDWLRQ1",48,0) S SDWLFD=$S(X="C":8,1:7) "RTN","SDWLRQ1",49,0) S SDWLCTX=X "RTN","SDWLRQ1",50,0) K DIR,DIC,DR "RTN","SDWLRQ1",51,0) S ^TMP("SDWLRQ1",$J,"CT1")=SDWLCTX_"^"_SDWLF_"^"_SDWLFD,DIC("A")=SDWLX,SDWLE=0 "RTN","SDWLRQ1",52,0) CT1 W ! S DIC(0)="QEMNZA",DIC=SDWLF D ^DIC I 'SDWLE,Y<1 S ^TMP("SDWLRQ1",$J,"CT2")="ALL" G CT3 "RTN","SDWLRQ1",53,0) I Y<0,'$D(^TMP("SDWLRQ1",$J,"CT1")) W !,"This Entry is Required." G CAT "RTN","SDWLRQ1",54,0) G CT2:Y<0 "RTN","SDWLRQ1",55,0) S SDWLCAT=SDWLCAT_Y_";",DIC("A")="Another "_$P(SDWLX,":",1)_": ",SDWLE=1 G CT1 "RTN","SDWLRQ1",56,0) CT2 G CT1:'$D(SDWLCAT) S ^TMP("SDWLRQ1",$J,"CT2")=SDWLCAT "RTN","SDWLRQ1",57,0) CT3 Q "RTN","SDWLRQ1",58,0) DATE ;Date range selection "RTN","SDWLRQ1",59,0) K X,Y,%DT "RTN","SDWLRQ1",60,0) S %=1 W !!,"Print Report for ALL dates? " D YN^DICN "RTN","SDWLRQ1",61,0) I %=1 S ^TMP("SDWLRQ1",$J,"DATE")="ALL" G E1 "RTN","SDWLRQ1",62,0) Q:%=0 "RTN","SDWLRQ1",63,0) Q:%=-1 "RTN","SDWLRQ1",64,0) ; SD*5.3*645 - replaced 'Desired Date' with 'CID/Preferred Date' "RTN","SDWLRQ1",65,0) ;S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start with Desired Appointment Date: " D ^%DT "RTN","SDWLRQ1",66,0) S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start with CID/Preferred Appointment Date: " D ^%DT "RTN","SDWLRQ1",67,0) I X["^" S SDWLERR=1 Q "RTN","SDWLRQ1",68,0) G E1:Y<0 S SDWLBDT=Y "RTN","SDWLRQ1",69,0) Q:$D(DUOUT) "RTN","SDWLRQ1",70,0) ; SD*5.3*645 - replaced 'Desired Date' with 'CID/Preferred Date' "RTN","SDWLRQ1",71,0) ;S %DT(0)=SDWLBDT,%DT("A")="End with Desired Appointment Date: " D ^%DT G DATE:Y<1 S SDWLEDT=Y K %DT(0),%DT("A") "RTN","SDWLRQ1",72,0) S %DT(0)=SDWLBDT,%DT("A")="End with CID/Preferred Appointment Date: " D ^%DT G DATE:Y<1 S SDWLEDT=Y K %DT(0),%DT("A") "RTN","SDWLRQ1",73,0) G DATE:$D(DUOUT) "RTN","SDWLRQ1",74,0) I SDWLEDT1 !,?33 W SDWLY(I) "RTN","SDWLRQ1",102,0) .K SDWLY "RTN","SDWLRQ1",103,0) I SDWLINS["ALL" W !,?20,"Institution: ALL " "RTN","SDWLRQ1",104,0) Q "RTN","SDWLRQ1",105,0) CT I SDWLCT2'["ALL" D "RTN","SDWLRQ1",106,0) .S SDWLF=$P(SDWLCT1,U,2) "RTN","SDWLRQ1",107,0) .K SDWLY F I=1:1 S SDWLY=$P($P(SDWLCT2,";",I),U,2) Q:SDWLY="" S SDWLY(I)=SDWLY "RTN","SDWLRQ1",108,0) .W !,?16,"Report Category: " W $S(SDWLCT1["C":"Clinic",1:"Service Specialty"),!,?36 I @X="ALL" W "All " "RTN","SDWLRQ1",109,0) .I $D(SDWLY) S I="" F S I=$O(SDWLY(I)) Q:I="" W:I>1 !,?35 W $$EXTERNAL^DILFD(SDWLF,.01,,SDWLY(I)) "RTN","SDWLRQ1",110,0) I SDWLCT2["ALL" W !,?16,"Report Category: " W $S(SDWLCT1["C":"Clinic",1:"Service Specialty"),!,?36 W "ALL " "RTN","SDWLRQ1",111,0) Q "RTN","SDWLRQ1",112,0) ; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date', adjusted format "RTN","SDWLRQ1",113,0) DA ;W !,?13,"Date Desired Range: " S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBD=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLED=Y "RTN","SDWLRQ1",114,0) W !,?7,"CID/Preferred Date Range: " S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBD=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLED=Y "RTN","SDWLRQ1",115,0) W " ",SDWLBD "RTN","SDWLRQ1",116,0) I SDWLED'="" W " to ",SDWLED "RTN","SDWLRQ1",117,0) Q "RTN","SDWLRQ1",118,0) OP W !,?18,"Output Format: ",$S(SDWLFORM="D":" Detailed",1:" Summary") "RTN","SDWLRQ1",119,0) Q "RTN","SDWLRQ1",120,0) PR I SDWLOPEN=1 W !,?25,"Printing 'OPEN' Entries Only." "RTN","SDWLRQ1",121,0) E W !,?25,"Printing ALL Entries." "RTN","SDWLRQ1",122,0) S %=1 W !!,"Are these Parameters Correct " D YN^DICN I %=2 S SDWLERR=1 W !," This Report will NOT be queued to print." "RTN","SDWLRQ1",123,0) I SDWLERR S DIR(0)="E" D ^DIR I X["^" S SDWLERR=2 "RTN","SDWLRQ1",124,0) Q "RTN","SDWLRQ1",125,0) QUE ;Queue Report "RTN","SDWLRQ1",126,0) N ZTQUEUED,POP "RTN","SDWLRQ1",127,0) K %ZIS,IOP,IOC,ZTIO S %ZIS="MQ" D ^%ZIS G:POP QUE1 "RTN","SDWLRQ1",128,0) S ZTRTN=$S(SDWLFORM="D":"EN^SDWLRPT1",1:"EN^SDWLRPS1"),ZTDTH=$H,ZTDESC="WAIT LIST REPORT FORMAT 1" "RTN","SDWLRQ1",129,0) S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLRQ1",$J,SDWLTASK)) Q:SDWLTASK="" D "RTN","SDWLRQ1",130,0) .S SDWLTK=$G(^TMP("SDWLRQ1",$J,SDWLTASK)) "RTN","SDWLRQ1",131,0) .S ZTSAVE(SDWLTASK)=SDWLTK "RTN","SDWLRQ1",132,0) S ZTSAVE("SDWLF")="" ; SD*5.3*412 "RTN","SDWLRQ1",133,0) I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G END "RTN","SDWLRQ1",134,0) QUE1 S:$E(IOST,1,2)="C-" SDWLSPT=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLSPT "RTN","SDWLRQ1",135,0) ; "RTN","SDWLRQ1",136,0) END ; "RTN","SDWLRQ1",137,0) K SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI,I "RTN","SDWLRQ1",138,0) K DIR,DIC,DR,DIE,SDWLERR,SDWLF,SDWLX,SDLFD,SDWLCTX,SDWLDAT,SDWLPROM,SDWLINST,SDWLI,SDWLTAG,SDWLY "RTN","SDWLRQ1",139,0) D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" "RTN","SDWLRQ1",140,0) Q "RTN","SDWLRQ1",141,0) HD W:$D(IOF) @IOF W !,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report" "RTN","SDWLRQ1",142,0) Q "RTN","SDWLWTR") 0^12^B2690330^B2642955 "RTN","SDWLWTR",1,0) SDWLWTR ;IOFO BAY PINES/DMR - EWL WAIT TIME REPORT 8/1/06 ;1/11/16 10:21am "RTN","SDWLWTR",2,0) ;;5.3;scheduling;**419,645**;AUG 13 1993;Build 7 "RTN","SDWLWTR",3,0) START ; "RTN","SDWLWTR",4,0) W !,"EWL Wait Time Statistics" "RTN","SDWLWTR",5,0) W !,"The following fields from file SD WAIT LIST (#409.3) are included in this report." "RTN","SDWLWTR",6,0) W !!," Originating Date" "RTN","SDWLWTR",7,0) W !," Scheduling Date of Appt" "RTN","SDWLWTR",8,0) W !," Date Appt Made" "RTN","SDWLWTR",9,0) W !," Date of Disposition" "RTN","SDWLWTR",10,0) ; SD*5.3*645 - replaced Desired Date with CID/Preferred Date "RTN","SDWLWTR",11,0) ;W !," Desired Date of Appointment" "RTN","SDWLWTR",12,0) W !," CID/Preferred Date of Appointment" "RTN","SDWLWTR",13,0) W !! "RTN","SDWLWTR",14,0) CAL W !,"The following fields are computed calculations included in the report." "RTN","SDWLWTR",15,0) W !,"Refer to the following report key to translate field values:" "RTN","SDWLWTR",16,0) W !!," a = Scheduled Date of Appt - Originating Date" "RTN","SDWLWTR",17,0) ; SD*5.3*645 replaced Desired Date with CID/Preferred Date "RTN","SDWLWTR",18,0) ;W !," b = Desired Date of Appointment - Originating Date" "RTN","SDWLWTR",19,0) W !," b = CID/Preferred Date of Appointment - Originating Date" "RTN","SDWLWTR",20,0) ;W !," c = Desired Date of Appointment - Scheduled Date of Appt" "RTN","SDWLWTR",21,0) W !," c = CID/Preferred Date of Appointment - Scheduled Date of Appt" "RTN","SDWLWTR",22,0) W !," d = Date of Disposition - Originating Date" "RTN","SDWLWTR",23,0) W !," e = Originating Date - Date Appt Made" "SEC","^DD",409.36,409.36,22,8.5) # "UP",2,2.98,-1) 2^S "UP",2,2.98,0) 2.98 "VER") 8.0^22.0 "^DD",2,2.98,27,0) DESIRED DATE OF APPOINTMENT^D^^1;1^S %DT="EX" D ^%DT S X=Y K:Y<1 X "^DD",2,2.98,27,.1) CID/PREFERRED DATE "^DD",2,2.98,27,1,0) ^.1^^0 "^DD",2,2.98,27,3) Enter the clinician or patient desired date for this appointment. "^DD",2,2.98,27,21,0) ^.001^5^5^3151112^^^ "^DD",2,2.98,27,21,1,0) This is the desired date for the appointment. The field title contains "^DD",2,2.98,27,21,2,0) 'CID/PREFERRED DATE', where 'CID' stands for Clinically Indicated Date. "^DD",2,2.98,27,21,3,0) This is an alternate name for the field name used for reports and to "^DD",2,2.98,27,21,4,0) present to users when adding and displaying appointment information in the "^DD",2,2.98,27,21,5,0) Scheduling package. "^DD",2,2.98,27,"DT") 3151112 "^DD",409.3,409.3,22,0) DESIRED DATE OF APPOINTMENT^RD^^0;16^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",409.3,409.3,22,.1) CID/PREFERRED DATE "^DD",409.3,409.3,22,3) Enter the desired date for the appointment. The date can be imprecise. "^DD",409.3,409.3,22,21,0) ^.001^10^10^3151116^^ "^DD",409.3,409.3,22,21,1,0) If a patient is placed on a Service/Specialty or Clinic Specific "^DD",409.3,409.3,22,21,2,0) Wait List type, the date the appointment is needed/desired. "^DD",409.3,409.3,22,21,3,0) If the priority is ASAP, this is the date the patient "^DD",409.3,409.3,22,21,4,0) is placed on the Wait List(Sch/PCMM). "^DD",409.3,409.3,22,21,5,0) If the priority is Future, the user enters the date that the "^DD",409.3,409.3,22,21,6,0) patient/provider needs an appointment scheduled. "^DD",409.3,409.3,22,21,7,0) The field title contains 'CID/PREFERRED DATE', where 'CID' stands for "^DD",409.3,409.3,22,21,8,0) Clinically Indicated Date. This is an alternate name for the field name "^DD",409.3,409.3,22,21,9,0) used for reports and to present to users when adding and displaying "^DD",409.3,409.3,22,21,10,0) appointment information in the Scheduling package. "^DD",409.3,409.3,22,"DT") 3151116 "^DD",409.36,409.36,22,0) DESIRED DATE OF APPOINTMENT^D^^WL;3^S %DT="E" D ^%DT S X=Y K:Y<1 X "^DD",409.36,409.36,22,.1) CID/PREFERRED DATE "^DD",409.36,409.36,22,3) Enter the desired date for the appointment. The date can be imprecise. "^DD",409.36,409.36,22,21,0) ^^5^5^3160107^ "^DD",409.36,409.36,22,21,1,0) Desired Date of Appointment taken from the Wait List Entry file from the "^DD",409.36,409.36,22,21,2,0) transmitting facility. The field title contains 'CID/PREFERRED DATE', "^DD",409.36,409.36,22,21,3,0) where 'CID' stands for Clinically Indicated Date. This is an alternate "^DD",409.36,409.36,22,21,4,0) name for the field name used for reports and to present to users when "^DD",409.36,409.36,22,21,5,0) adding and displaying appointment information in the Scheduling package. "^DD",409.36,409.36,22,"DT") 3160107 "BLD",9598,6) ^537 **END** **END**