Released SD*5.3*618 SEQ #515 Extracted from mail message **KIDS**:SD*5.3*618^ **INSTALL NAME** SD*5.3*618 "BLD",9732,0) SD*5.3*618^SCHEDULING^0^3140818^y "BLD",9732,1,0) ^^9^9^3140818^^^^ "BLD",9732,1,1,0) This patch will fix/update the following three (3) issues: "BLD",9732,1,2,0) "BLD",9732,1,3,0) 1. Patient names are not sorted in alphabetical order for the Appointment "BLD",9732,1,4,0) List. "BLD",9732,1,5,0) "BLD",9732,1,6,0) 2. The description for appointment type Organ Donors. "BLD",9732,1,7,0) "BLD",9732,1,8,0) 3. The length of the data field Clinic IEN Number in the Patient "BLD",9732,1,9,0) Appointment Information Transmission (PAIT) documentation. "BLD",9732,4,0) ^9.64PA^^ "BLD",9732,6.3) 3 "BLD",9732,"ABPKG") n "BLD",9732,"INID") ^n "BLD",9732,"INIT") EN^SD53P618 "BLD",9732,"KRN",0) ^9.67PA^779.2^20 "BLD",9732,"KRN",.4,0) .4 "BLD",9732,"KRN",.401,0) .401 "BLD",9732,"KRN",.402,0) .402 "BLD",9732,"KRN",.403,0) .403 "BLD",9732,"KRN",.5,0) .5 "BLD",9732,"KRN",.84,0) .84 "BLD",9732,"KRN",3.6,0) 3.6 "BLD",9732,"KRN",3.8,0) 3.8 "BLD",9732,"KRN",9.2,0) 9.2 "BLD",9732,"KRN",9.8,0) 9.8 "BLD",9732,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",9732,"KRN",9.8,"NM",1,0) SDAL^^0^B32575250 "BLD",9732,"KRN",9.8,"NM",2,0) SDAL0^^0^B37381989 "BLD",9732,"KRN",9.8,"NM",3,0) SDCIAL^^0^B22822282 "BLD",9732,"KRN",9.8,"NM","B","SDAL",1) "BLD",9732,"KRN",9.8,"NM","B","SDAL0",2) "BLD",9732,"KRN",9.8,"NM","B","SDCIAL",3) "BLD",9732,"KRN",19,0) 19 "BLD",9732,"KRN",19.1,0) 19.1 "BLD",9732,"KRN",101,0) 101 "BLD",9732,"KRN",409.61,0) 409.61 "BLD",9732,"KRN",771,0) 771 "BLD",9732,"KRN",779.2,0) 779.2 "BLD",9732,"KRN",870,0) 870 "BLD",9732,"KRN",8989.51,0) 8989.51 "BLD",9732,"KRN",8989.52,0) 8989.52 "BLD",9732,"KRN",8994,0) 8994 "BLD",9732,"KRN","B",.4,.4) "BLD",9732,"KRN","B",.401,.401) "BLD",9732,"KRN","B",.402,.402) "BLD",9732,"KRN","B",.403,.403) "BLD",9732,"KRN","B",.5,.5) "BLD",9732,"KRN","B",.84,.84) "BLD",9732,"KRN","B",3.6,3.6) "BLD",9732,"KRN","B",3.8,3.8) "BLD",9732,"KRN","B",9.2,9.2) "BLD",9732,"KRN","B",9.8,9.8) "BLD",9732,"KRN","B",19,19) "BLD",9732,"KRN","B",19.1,19.1) "BLD",9732,"KRN","B",101,101) "BLD",9732,"KRN","B",409.61,409.61) "BLD",9732,"KRN","B",771,771) "BLD",9732,"KRN","B",779.2,779.2) "BLD",9732,"KRN","B",870,870) "BLD",9732,"KRN","B",8989.51,8989.51) "BLD",9732,"KRN","B",8989.52,8989.52) "BLD",9732,"KRN","B",8994,8994) "BLD",9732,"QDEF") ^^^^NO^^^^^^YES "BLD",9732,"QUES",0) ^9.62^^ "BLD",9732,"REQB",0) ^9.611^2^2 "BLD",9732,"REQB",1,0) SD*5.3*406^2 "BLD",9732,"REQB",2,0) SD*5.3*572^2 "BLD",9732,"REQB","B","SD*5.3*406",1) "BLD",9732,"REQB","B","SD*5.3*572",2) "INIT") EN^SD53P618 "MBREQ") 0 "PKG",16,-1) 1^1 "PKG",16,0) SCHEDULING^SD^APPOINTMENTS,PROFILES,LETTERS,AMIS REPORTS "PKG",16,20,0) ^9.402P^^ "PKG",16,22,0) ^9.49I^1^1 "PKG",16,22,1,0) 5.3^2930813 "PKG",16,22,1,"PAH",1,0) 618^3140818 "PKG",16,22,1,"PAH",1,1,0) ^^9^9^3140818 "PKG",16,22,1,"PAH",1,1,1,0) This patch will fix/update the following three (3) issues: "PKG",16,22,1,"PAH",1,1,2,0) "PKG",16,22,1,"PAH",1,1,3,0) 1. Patient names are not sorted in alphabetical order for the Appointment "PKG",16,22,1,"PAH",1,1,4,0) List. "PKG",16,22,1,"PAH",1,1,5,0) "PKG",16,22,1,"PAH",1,1,6,0) 2. The description for appointment type Organ Donors. "PKG",16,22,1,"PAH",1,1,7,0) "PKG",16,22,1,"PAH",1,1,8,0) 3. The length of the data field Clinic IEN Number in the Patient "PKG",16,22,1,"PAH",1,1,9,0) Appointment Information Transmission (PAIT) documentation. "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") YES "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") 4 "RTN","SD53P618") 0^^B5848002^n/a "RTN","SD53P618",1,0) SD53P618 ;ALB/TXH - POST INIT ROUTINE FOR PATCH SD*5.3*618;Jul 22, 2014 "RTN","SD53P618",2,0) ;;5.3;Scheduling;**618**;Aug 13, 1993;Build 3 "RTN","SD53P618",3,0) ; "RTN","SD53P618",4,0) ; This is the post-install for patch SD*5.3*618 to modify DESCRIPTION "RTN","SD53P618",5,0) ; field (#10) of Appointment Type ORGAN DONORS in APPOINTMENT TYPE "RTN","SD53P618",6,0) ; file (#409.1). "RTN","SD53P618",7,0) Q "RTN","SD53P618",8,0) ; "RTN","SD53P618",9,0) EN ; Entry point "RTN","SD53P618",10,0) N SDFILE,SDFLD,SDTYPE "RTN","SD53P618",11,0) S SDFILE=409.1,SDFLD=10,SDTYPE="ORGAN DONORS" "RTN","SD53P618",12,0) D BMES^XPDUTL("SD*5.3*618 Post Installation -- ") "RTN","SD53P618",13,0) D MES^XPDUTL(" ") "RTN","SD53P618",14,0) D MES^XPDUTL("Update to APPOINTMENT TYPE file (#"_SDFILE_").") "RTN","SD53P618",15,0) I '$D(^SD(SDFILE)) D BMES^XPDUTL("Missing file "_SDFILE_".") "RTN","SD53P618",16,0) I $D(^SD(SDFILE)) D ACT "RTN","SD53P618",17,0) Q "RTN","SD53P618",18,0) ; "RTN","SD53P618",19,0) ACT ; Add new text "RTN","SD53P618",20,0) N SDIEN,SDLINE,SDX "RTN","SD53P618",21,0) I '$D(^SD(SDFILE,"B",SDTYPE)) D MISSMSG Q "RTN","SD53P618",22,0) S SDIEN=$O(^SD(SDFILE,"B",SDTYPE,"")) "RTN","SD53P618",23,0) I '$D(^SD(SDFILE,SDIEN,0)) D MISSMSG Q "RTN","SD53P618",24,0) F SDX=1:1 S SDLINE=$P($T(SDTXT+SDX),";;",2) Q:SDLINE="QUIT" D "RTN","SD53P618",25,0) . S SD(SDX,0)=SDLINE "RTN","SD53P618",26,0) S SDIEN=SDIEN_"," "RTN","SD53P618",27,0) D WP^DIE(SDFILE,SDIEN,SDFLD,"K","SD","ERR") "RTN","SD53P618",28,0) ; Display error messages if unsuccessful "RTN","SD53P618",29,0) I $D(ERR) D Q "RTN","SD53P618",30,0) . S SDX="ERR" F S SDX=$Q(@SDX) Q:SDX="" D "RTN","SD53P618",31,0) . . D BMES^XPDUTL(SDX) "RTN","SD53P618",32,0) . . D MES^XPDUTL(@SDX) "RTN","SD53P618",33,0) . D BMES^XPDUTL("*** Warning - DESCRIPTION field of") "RTN","SD53P618",34,0) . D MES^XPDUTL(" Appointment Type "_SDTYPE_", file #409.1") "RTN","SD53P618",35,0) . D MES^XPDUTL(" could not be modified.") "RTN","SD53P618",36,0) . D BMES^XPDUTL(" Please contact the PIMS NATIONAL VISTA SUPPORT Team.") "RTN","SD53P618",37,0) . D MES^XPDUTL(" for assistance.") "RTN","SD53P618",38,0) D BMES^XPDUTL("DESCRIPTION of Appointment Type "_SDTYPE_" successfully modified.") "RTN","SD53P618",39,0) D MES^XPDUTL(" ") "RTN","SD53P618",40,0) ; "RTN","SD53P618",41,0) K ERR,SD,SDIEN,SDLINE,SDX "RTN","SD53P618",42,0) Q "RTN","SD53P618",43,0) ; "RTN","SD53P618",44,0) MISSMSG ; Missing messages "RTN","SD53P618",45,0) D BMES^XPDUTL("Missing Appointment Type ORGAN DONORS in file #409.1...") "RTN","SD53P618",46,0) D MES^XPDUTL("Please contact the PIMS NATIONAL VISTA SUPPORT Team.") "RTN","SD53P618",47,0) Q "RTN","SD53P618",48,0) ; "RTN","SD53P618",49,0) SDTXT ; New text for DESCRIPTION field "RTN","SD53P618",50,0) ;;Exam of a veteran or non-veteran who wishes to be an organ "RTN","SD53P618",51,0) ;;donor to determine if organ designated will be useable. "RTN","SD53P618",52,0) ;;QUIT "RTN","SDAL") 0^1^B32575250^B31245513 "RTN","SDAL",1,0) SDAL ;ALB/GRR,MJK - APPOINTMENT LIST ;29 Jun 99 04:11PM ; Compiled August 20, 2007 14:24:59 "RTN","SDAL",2,0) ;;5.3;Scheduling;**37,46,106,171,177,80,266,491,572,618**;Aug 13, 1993;Build 3 "RTN","SDAL",3,0) EN W ! S SDEND=1 D ASK2^SDDIV G:Y<0 END "RTN","SDAL",4,0) W ! S VAUTNI=1 D NCOUNT^SDAL0 I SDCONC=U G END "RTN","SDAL",5,0) W ! D NCLINIC^SDAL0 G:Y<0 END "RTN","SDAL",6,0) RD1 W ! N %DT K DIC("S") S %DT("A")="For date: ",%DT="AEX" D ^%DT "RTN","SDAL",7,0) I (X["^")!(Y<0) K %,VAUTD,VAUTC,X,Y Q "RTN","SDAL",8,0) S SDD=Y "RTN","SDAL",9,0) N DIR S DIR(0)="Y",DIR("B")="NO" "RTN","SDAL",10,0) S DIR("A")="Include Primary Care assignment information in the output" "RTN","SDAL",11,0) W ! D ^DIR I $D(DTOUT)!$D(DUOUT) K SDD,VAUTC,VAUTD,X,Y Q "RTN","SDAL",12,0) W ! S SDPCMM=Y "RTN","SDAL",13,0) N K SDX,SDX1 R !,"Number of copies: 1// ",M:DTIME S:M="" M=1 "RTN","SDAL",14,0) I M["^" K M,SDD,VAUTC,VAUTD,X,Y Q "RTN","SDAL",15,0) I (M'?.N)!((M'>0)!($L(M)>3)) W !,"ENTER A WHOLE NUMBER TO SELECT THE # OF COPIES OF THE APPOINTMENT LIST THAT ARE NEEDED- (1-999)" G N "RTN","SDAL",16,0) S SDCOPY=M "RTN","SDAL",17,0) ; -- specify device "RTN","SDAL",18,0) W ! N %ZIS K IO("Q") S %ZIS="QMP" D ^%ZIS G END:POP "RTN","SDAL",19,0) S SDBC=$$BARQ(+IOST(0),IOM) I SDBC="^" G END "RTN","SDAL",20,0) I $D(IO("Q")) D QUE W:$D(ZTSK) " (Task#: ",ZTSK,")" G END "RTN","SDAL",21,0) ; "RTN","SDAL",22,0) START U IO N CNT,SDCLAR,SDCOUNT S (SDCOUNT,CNT)=0 "RTN","SDAL",23,0) ;SET UP A TEMP ARRAY -SDCLAR- WITH CLASSIFICATION ABBREVIATIONS "RTN","SDAL",24,0) F S CNT=$O(^SD(409.41,CNT)) Q:CNT'>0 D "RTN","SDAL",25,0) .S SDCLAR(CNT)=$P(^SD(409.41,CNT,0),U,7) "RTN","SDAL",26,0) S:'$D(DTIME) DTIME=300 I '$D(DT) D DT^SDUTL "RTN","SDAL",27,0) S SDASH="",$P(SDASH,"_",IOM+1)="" S SDBC=+$G(SDBC),SDCOPY=$S($D(SDCOPY):+SDCOPY,$D(M):+M,1:1) "RTN","SDAL",28,0) D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2) "RTN","SDAL",29,0) I SDBC S SDBC=$S(IOM<120:0,1:$$BARC^SDAMU(+IOST(0),.SDBCON,.SDBCOFF)) "RTN","SDAL",30,0) S (SDEND,SD1,PCNT)=0,Y=DT D D^DIQ S SDNT=Y,Y=SDD,X=Y D D^DIQ S SDPD=Y D DW^%DTC S SDPD=X_" "_SDPD "RTN","SDAL",31,0) ;if user has selected 'all' clinics, populate VAUTC with all uncancelled TYPE=C clinics from ^SC "RTN","SDAL",32,0) I VAUTC=1 S SDIEN=0 F S SDIEN=$O(^SC(SDIEN)) Q:+SDIEN=0 D "RTN","SDAL",33,0) . I $P(^SC(SDIEN,0),"^",3)="C",$G(^SC(SDIEN,"ST",SDD,1))'["CANCELLED" D "RTN","SDAL",34,0) .. S SDNAME=$P(^SC(SDIEN,0),"^",1) I $G(SDNAME)]"" S VAUTC(SDNAME)=SDIEN "RTN","SDAL",35,0) ;-------------CALL TO SDAPI^SDAMA301 TO RETRIEVE APPT DATA------------------ "RTN","SDAL",36,0) K ^TMP($J,"SDAMA301") N SDARRAY,SDIEN,SDNAME,SDERR,SDCL,SDDFN,SDDT,SDRESULT "RTN","SDAL",37,0) S SDARRAY(1)=SDD_";"_SDD,SDARRAY(3)="I;R;NT",SDARRAY("FLDS")="4;6;7;8;10;19;20;21" "RTN","SDAL",38,0) ;if user has selected clinics, build clinic filter list "RTN","SDAL",39,0) I VAUTC'=1 D I $L(SDARRAY(2)) S SDARRAY(2)=$E(SDARRAY(2),1,$L(SDARRAY(2))-1) ;remove last ';' from end "RTN","SDAL",40,0) . S SD="" F S SD=$O(VAUTC(SD)) Q:SD']"" S SC=$G(VAUTC(SD)) I $G(SC)]"" S SDARRAY(2)=$G(SDARRAY(2))_SC_";" "RTN","SDAL",41,0) ;call SDAPI to retrieve appointment data "RTN","SDAL",42,0) S SDRESULT=$$SDAPI^SDAMA301(.SDARRAY) "RTN","SDAL",43,0) ;if error returned from SDAPI, display on report and quit "RTN","SDAL",44,0) I SDRESULT<0 S SDERR=$$SDAPIERR^SDAMUTDT() I $L(SDERR) S SC=0 S SDPAGE=1 D HED W !!,SDERR,! D:$E(IOST,1,2)="C-" OUT^SDUTL D EXIT Q "RTN","SDAL",45,0) ;if appts returned from SDAPI, sort output by clinic, appt d/t, patient "RTN","SDAL",46,0) I SDRESULT>0 D "RTN","SDAL",47,0) . S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",SDCL)) Q:'SDCL D "RTN","SDAL",48,0) .. S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",SDCL,SDDFN)) Q:'SDDFN D "RTN","SDAL",49,0) ... S SDDT=0 F S SDDT=$O(^TMP($J,"SDAMA301",SDCL,SDDFN,SDDT)) Q:'SDDT D "RTN","SDAL",50,0) .... ;SD*618 Add patient's name to be one of the sort filter (Patient's Name~DFN) "RTN","SDAL",51,0) .... S SDPNDFN=$P(^DPT(SDDFN,0),U,1)_"~"_SDDFN "RTN","SDAL",52,0) .... M ^TMP($J,"SDAMA301","S",SDCL,SDDT,SDPNDFN)=^TMP($J,"SDAMA301",SDCL,SDDFN,SDDT) "RTN","SDAL",53,0) ;--------------------------------------------------------------------------- "RTN","SDAL",54,0) LOOPA ;if no error returned from SDAPI, start looping through clinics in VAUTC (sorted by name) "RTN","SDAL",55,0) I SDRESULT'<0 S SD=0 F S SD=$O(VAUTC(SD)) Q:SD']""!SDEND D CLIN "RTN","SDAL",56,0) G:SDEND END "RTN","SDAL",57,0) OVER ;S PCNT=PCNT+1 I PCNT0,$D(^SC(SC,0)) D LOOP^SDAL0 "RTN","SDAL",73,0) Q "RTN","SDAL",74,0) ; "RTN","SDAL",75,0) BARQ(TTYPE,MARGIN) ; "RTN","SDAL",76,0) N ON,OFF,Y "RTN","SDAL",77,0) I MARGIN<120 S Y=0 G BARCQ "RTN","SDAL",78,0) I '$$BARC^SDAMU(.TTYPE,.ON,.OFF) S Y=0 G BARCQ "RTN","SDAL",79,0) S DIR(0)="Y",DIR("B")="NO",DIR("A")="SHOULD BARCODES BE PRINTED ON LIST(S)" "RTN","SDAL",80,0) D ^DIR K DIR S:$D(DIRUT) Y="^" "RTN","SDAL",81,0) BARCQ Q Y "RTN","SDAL",82,0) ; "RTN","SDAL",83,0) QUE ;Queue output "RTN","SDAL",84,0) N ZTDESC,ZTSAVE,ZTRTN "RTN","SDAL",85,0) K ZTSK,IO("Q") "RTN","SDAL",86,0) S ZTDESC="Appointment Lists",ZTRTN="START^SDAL" "RTN","SDAL",87,0) F X="VAUTD(","VAUTC(","SDCOPY","SDD","SDBC","VAUTD","VAUTC","SDCONC","SDPCMM" S ZTSAVE(X)="" "RTN","SDAL",88,0) D ^%ZTLOAD "RTN","SDAL",89,0) Q "RTN","SDAL",90,0) ; "RTN","SDAL",91,0) STOP ;Check for stop task request "RTN","SDAL",92,0) S:$D(ZTQUEUED) (SDEND,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q "RTN","SDAL",93,0) ; "RTN","SDAL",94,0) HED ;Print report header "RTN","SDAL",95,0) I SD1,$E(IOST)="C" D OUT^SDUTL Q:SDEND "RTN","SDAL",96,0) D STOP Q:SDEND "RTN","SDAL",97,0) S SDCOUNT=SDCOUNT+1,SD1=1 "RTN","SDAL",98,0) W:SDCOUNT>1!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0) "RTN","SDAL",99,0) W:SC "Appointments for ",$P(^SC(SC,0),"^",1)," clinic on ",SDPD "RTN","SDAL",100,0) ;SD*572 added following naked reference logic "RTN","SDAL",101,0) I 'SC D "RTN","SDAL",102,0) .I VAUTC W "Appointments for ALL clinics for ",SDPD Q "RTN","SDAL",103,0) .S CT=0,SNAM="" "RTN","SDAL",104,0) .F S SNAM=$O(VAUTC(SNAM)) Q:SNAM="" S CT=CT+1,SC=$G(VAUTC(SNAM)) "RTN","SDAL",105,0) .I CT=1 W "Appointments for ",$P(^SC(SC,0),U,1)," clinic on ",SDPD D INACT "RTN","SDAL",106,0) .I CT>1!(CT<1) W "Appointments for Selected clinics for ",SDPD "RTN","SDAL",107,0) .K CT,SNAM,SC "RTN","SDAL",108,0) W !,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,! "RTN","SDAL",109,0) W !," Appt.",?11,"Patient Name",?44,"SSN",?53,"Lab",?62,"X-Ray",?73,"EKG" "RTN","SDAL",110,0) W !," Time",?53,"Time",?62,"Time",?73,"Time",!,?15,"Other Information",?40,"Ward Location",!,?41,"Room-Bed" "RTN","SDAL",111,0) W !,SDASH S SDPAGE=SDPAGE+1 "RTN","SDAL",112,0) D:SDBC PAINT(SC,SDD) "RTN","SDAL",113,0) Q "RTN","SDAL",114,0) ; "RTN","SDAL",115,0) PAINT(CLINIC,DATE) ; -- paint header barcodes "RTN","SDAL",116,0) ; input: CLINIC := clinic ifn "RTN","SDAL",117,0) ; DATE := appt date only "RTN","SDAL",118,0) ; "RTN","SDAL",119,0) W !?10,"Date",?45,"Clinic#",?85,"No",?110,"Yes",! "RTN","SDAL",120,0) D BARC(10,$E(DATE,4,7)_$E(DATE,2,3)) "RTN","SDAL",121,0) D BARC(45,"%"_CLINIC_"$") "RTN","SDAL",122,0) D BARC(85,"N"),BARC(110,"Y") "RTN","SDAL",123,0) W !!!!,SDASH "RTN","SDAL",124,0) Q "RTN","SDAL",125,0) ; "RTN","SDAL",126,0) BARC(TAB,X) ; --print barcode "RTN","SDAL",127,0) ; input: TAB := tab position "RTN","SDAL",128,0) ; X := string to print "RTN","SDAL",129,0) ; "RTN","SDAL",130,0) W *13,?TAB W @SDBCON,X,@SDBCOFF "RTN","SDAL",131,0) Q "RTN","SDAL",132,0) ; "RTN","SDAL",133,0) INACT ;SD*572 if single clinic selected check if inactive on selected date "RTN","SDAL",134,0) I $D(^SC(SC,"I")) I SDD=$P($G(^("I")),U,1)!(SDD>$P($G(^("I")),U,1)),'$P($G(^("I")),U,2) S SDPCT="Clinic Inactive on this date!" Q "RTN","SDAL",135,0) I $D(^SC(SC,"I")) I SDD=$P($G(^("I")),U,1)!(SDD>$P($G(^("I")),U,1))&(SDD<$P($G(^("I")),U,2)) S SDPCT="Clinic Inactive on this date!" Q "RTN","SDAL",136,0) S SDPCT="No Clinic Availability on this date!" "RTN","SDAL",137,0) Q "RTN","SDAL",138,0) ; "RTN","SDAL0") 0^2^B37381989^B36699440 "RTN","SDAL0",1,0) SDAL0 ;ALB/GRR,TMP,MJK - APPOINTMENT LIST (CONTINUED FROM SDAL) ;29 Jun 99 04:11PM "RTN","SDAL0",2,0) ;;5.3;Scheduling;**28,37,106,149,171,177,193,305,373,266,572,618**;Aug 13, 1993;Build 3 "RTN","SDAL0",3,0) LOOP I 'VAUTC,$G(^SC(SC,"ST",SDD,1))["CANCELLED" D Q "RTN","SDAL0",4,0) .S SDPAGE=1 D HED^SDAL "RTN","SDAL0",5,0) .S SDPCT="Clinic cancelled for this date!" "RTN","SDAL0",6,0) .W !!?(IOM-$L(SDPCT)\2),SDPCT "RTN","SDAL0",7,0) I $$CHECK(),$$NCHECK(),$$ACTIVE() D "RTN","SDAL0",8,0) .S SDPAGE=1 D HED^SDAL Q:SDEND S SDPCT=0,SDFLG=1 ;SD*572 set flag "RTN","SDAL0",9,0) .;loop through sorted appointment data for the clinic "RTN","SDAL0",10,0) .N SDT,SDDFN,SDDATA,SDDATAC S SDT="" F S SDT=$O(^TMP($J,"SDAMA301","S",SC,SDT)) Q:'SDT D "RTN","SDAL0",11,0) ..S SDDFN="" F S SDDFN=$O(^TMP($J,"SDAMA301","S",SC,SDT,SDDFN)) Q:(SDDFN="")!SDEND D "RTN","SDAL0",12,0) ...;store appt data and comments for later reference "RTN","SDAL0",13,0) ...;SD*618 Patient's name added to one of the sort filter (Patient's name~DFN) "RTN","SDAL0",14,0) ...S SDDATA=$G(^TMP($J,"SDAMA301","S",SC,SDT,SDDFN)),SDDATAC=$G(^(SDDFN,"C")) "RTN","SDAL0",15,0) ...D MORE "RTN","SDAL0",16,0) .W ! D CCLK Q:SDEND "RTN","SDAL0",17,0) .I 'SDPCT S SDPCT="No activity found for this clinic date!" W !!?(IOM-$L(SDPCT)\2),SDPCT "RTN","SDAL0",18,0) S SDPAGE=1 Q "RTN","SDAL0",19,0) ; "RTN","SDAL0",20,0) PTL N SDAPPT "RTN","SDAL0",21,0) S DFN=+$P(SDDATA,"^",4),SDOI=$G(SDDATAC) "RTN","SDAL0",22,0) S SDAPPT="" "RTN","SDAL0",23,0) D ^VAUQWK,GETA "RTN","SDAL0",24,0) I ($Y+7>IOSL) D HED^SDAL Q:SDEND "RTN","SDAL0",25,0) I '$D(SDFS) S SDFS=1,X=PT D TM^SDROUT0 W !,$J(X,8) "RTN","SDAL0",26,0) N SDCLY D CL^SDCO21(DFN,SDT,"",.SDCLY) "RTN","SDAL0",27,0) N SDY S SDY=$Y "RTN","SDAL0",28,0) W ! D:SDBC BARC^SDAL(85,$P(VAQK(2),"^")) "RTN","SDAL0",29,0) ;check for Combat Vet "RTN","SDAL0",30,0) N SDCV "RTN","SDAL0",31,0) S SDCV=$$CVEDT^DGCV(DFN,$G(SDD)) "RTN","SDAL0",32,0) S SDCV=$P(SDCV,U,3) "RTN","SDAL0",33,0) W !?3,$S($G(SDCV)=1:"(CV)",1:""),?9,$S($P(SDDATA,"^",7)="Y":"*",1:""),?10,$S(VAQK(1)]"":VAQK(1),1:"UNKNOWN PATIENT"),?41,$S(VAQK(2)]"":$E(VAQK(2),1,9),1:"") "RTN","SDAL0",34,0) S INC=0 F SDZ=3,4,5 S X=SDZ(SDZ) D:X]"" TM^SDROUT0 S INC=SDZ#3*8+3 W ?48+INC,$J(X,8) W:INC<16 " " "RTN","SDAL0",35,0) I VAQK(12)]"" W !,?41,VAQK(12) W:VAQK(13)]"" !,?41,VAQK(13) "RTN","SDAL0",36,0) W:SDOI]"" !,?15,SDOI W:SDEM]"" !,?15,SDEM,$S($D(SDCP):$P(^SC(SDCP,0),"^"),1:$P(^SC(SC,0),"^")),!,?15,SDEM1 "RTN","SDAL0",37,0) W !,?10,"Phone #: ",$P($G(^DPT(DFN,.13)),"^",1) ;Phone Number [Residence] "RTN","SDAL0",38,0) S SDX="" F I=7:1:9 I VAQK(I) S SDX=1 Q "RTN","SDAL0",39,0) ;Primary Care information "RTN","SDAL0",40,0) I +$G(SDPCMM) D TDATA^SDPPTEM(DFN,"",SDD,"P",15) "RTN","SDAL0",41,0) ;; GAF SCORE CHECK "RTN","SDAL0",42,0) N SDGAF,SDGAFST "RTN","SDAL0",43,0) ;use Appt Type here since COLLATERAL VISIT field not supported by encapsulation API "RTN","SDAL0",44,0) I $$MHCLIN^SDUTL2(SC),'($$COLLAT^SDUTL2(+VAQK(6))!$P($P(SDDATA,"^",10),";",2)["COLLATERAL OF VET") D "RTN","SDAL0",45,0) . S SDGAF=$$NEWGAF^SDUTL2(DFN),SDGAFST=$P(SDGAF,"^") "RTN","SDAL0",46,0) . W:SDGAFST !,?15,"** New GAF Score Required **" "RTN","SDAL0",47,0) ;; "RTN","SDAL0",48,0) I $O(SDCLY(0)) D "RTN","SDAL0",49,0) .N PCL "RTN","SDAL0",50,0) .S PCL=0 "RTN","SDAL0",51,0) .W !,?15,"** Required for facility workload credit => " "RTN","SDAL0",52,0) .F S PCL=$O(SDCLY(PCL)) Q:'PCL D "RTN","SDAL0",53,0) .. W " ",SDCLAR(PCL)," " "RTN","SDAL0",54,0) .. I (SDCLAR(PCL)="SC")&($G(^DPT(DFN,0))]"") D "RTN","SDAL0",55,0) ... K SDELAR "RTN","SDAL0",56,0) ... S VAROOT="SDELAR" "RTN","SDAL0",57,0) ... D ELIG^VADPT "RTN","SDAL0",58,0) ... Q:'$P($G(SDELAR(3)),"^") "RTN","SDAL0",59,0) ... W $P(SDELAR(3),"^",2),"% " "RTN","SDAL0",60,0) ... K SDELAR,VAROOT "RTN","SDAL0",61,0) .W "**" "RTN","SDAL0",62,0) I $P(VAQK(11),"^",2)]"" W !,?15,"Means Test: ** ",$P(VAQK(11),"^",2)," **" W " Last Test: ",$$FDATE^SDUL1($P($$LST^DGMTU(DFN),U,2)) "RTN","SDAL0",63,0) S SDCOPS=$$LST^DGMTU(DFN,DT,2) I +SDCOPS W !,?15,"Co-Pay Status: ","**"_$P(SDCOPS,U,3)_"**"," Last Test: ",$$FDATE^SDUL1($P(SDCOPS,U,2)) K SDCOPS "RTN","SDAL0",64,0) I $D(^DIC(8,+VAQK(6),0)),$P(^(0),U,9)=13 W !,?15,"** COLLATERAL **" G Q "RTN","SDAL0",65,0) I +$P(SDDATA,"^",8)]"" D I V W !,?15,"** COLLATERAL **" G Q "RTN","SDAL0",66,0) .S V=+$P(SDDATA,"^",8),V=$S($D(^DIC(8,+V,0)):$P(^(0),"^",9)=13,1:0) "RTN","SDAL0",67,0) ;use Appt Type here since COLLATERAL VISIT field not supported by encapsulation API "RTN","SDAL0",68,0) I $P($P(SDDATA,"^",10),";",2)["COLLATERAL OF VET" W !,?15,"** COLLATERAL VISIT **" "RTN","SDAL0",69,0) I +$P($G(SDDATA),"^",8)=0 S V=0 "RTN","SDAL0",70,0) Q I SDBC,(SDY+5)>$Y F I=1:1 Q:(SDY+5)'>$Y W ! "RTN","SDAL0",71,0) I SDBC W !?9,$E(SDASH,9,255) "RTN","SDAL0",72,0) S SDPCT=SDPCT+1 K V,SDX,SDMT,VAQK Q "RTN","SDAL0",73,0) ; "RTN","SDAL0",74,0) GETA K SDCP S SDZ(3)=$P($G(SDDATA),"^",21),SDZ(4)=$P($G(SDDATA),"^",20),SDZ(5)=$P($G(SDDATA),"^",19) "RTN","SDAL0",75,0) S SDEM="",SDEC=+VAQK(6) Q:'SDEC "RTN","SDAL0",76,0) S SDXX=$S('$D(^DIC(8,SDEC,0)):1,$P(^(0),"^",5)'="Y":1,$P(^(0),"^",4)=4:0,$P(^(0),"^",4)=5:0,1:1) Q:SDXX "RTN","SDAL0",77,0) I $D(^SC(SC,"SL")),$P(^("SL"),U,5)]"",$D(^SC($P(^("SL"),U,5),0)) S SDCP=$P(^SC(SC,"SL"),U,5) "RTN","SDAL0",78,0) S SDCP=$S($D(SDCP):SDCP,1:SC) I $D(^DPT(DFN,"DE","B",SDCP)),VAQK(12)']"" S SDEA=$O(^DPT(DFN,"DE","B",SDCP,0)) I $D(^DPT(DFN,"DE",+SDEA,0)),$P(^(0),"^",2)']"",$O(^(1,0))'="" D CKCED "RTN","SDAL0",79,0) Q "RTN","SDAL0",80,0) ; "RTN","SDAL0",81,0) MORE K SDFS S PT=SDT D PTL "RTN","SDAL0",82,0) Q "RTN","SDAL0",83,0) ; "RTN","SDAL0",84,0) CCLK S SDCC=0 F S SDCC=$O(^SC(SC,"C",SDD,1,SDCC)) Q:'SDCC!SDEND S SDPT0=$G(^DPT(+^(SDCC,0),0)) I $L(SDPT0) D "RTN","SDAL0",85,0) .I ($Y+4>IOSL) D HED^SDAL Q:SDEND W ! "RTN","SDAL0",86,0) .W !,"CHART REQUEST: ",$P(SDPT0,"^",1),?34,$P(SDPT0,"^",9) "RTN","SDAL0",87,0) Q "RTN","SDAL0",88,0) ; "RTN","SDAL0",89,0) CKCED S A=0 F S A=$O(^DPT(DFN,"DE",SDEA,1,A)) Q:'A I $P(^DPT(DFN,"DE",SDEA,1,A,0),"^",3)']"" D ENR Q "RTN","SDAL0",90,0) Q "RTN","SDAL0",91,0) ; "RTN","SDAL0",92,0) ENR S SDEDT=$P(^(0),"^",1)\1,SDDIF=DT-SDEDT,SDREV=$P(^(0),"^",5),SDDIF1=$S(SDREV:DT-SDREV,1:"") ;NAKED REFERENCE - ^DPT(DFN,"DE",SDEA,1,A,0) "RTN","SDAL0",93,0) I $P(^DPT(DFN,"DE",SDEA,1,A,0),"^",2)="O",$S(SDDIF1']""&(SDDIF>10000):1,SDDIF1>10000:1,1:0) S SDEM="PATIENT HAS BEEN ENROLLED IN ",SDEM1="FOR MORE THAN 1 YEAR, PLEASE RE-EVALUATE" "RTN","SDAL0",94,0) Q "RTN","SDAL0",95,0) ; "RTN","SDAL0",96,0) CHECK() I $D(^SC(SC,0)),$P(^(0),"^",3)="C",$S(VAUTD:1,$D(VAUTD(+$P(^(0),"^",15))):1,'$P(^(0),"^",15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0) "RTN","SDAL0",97,0) I $T,$D(^SC(SC,"ST",SDD,1)),^(1)'["**CANCELLED",$S('$D(^SC(SC,"I")):1,+^("I")'>0:1,+^("I")>SDD:1,+^("I")'>SDD&(+$P(^("I"),"^",2)>SDD!(+$P(^("I"),"^",2)=0)):0,1:1) Q 1 "RTN","SDAL0",98,0) Q 0 "RTN","SDAL0",99,0) ; "RTN","SDAL0",100,0) NCOUNT ;COUNT, NON-COUNT, or BOTH FOR CLINIC SELECTION "RTN","SDAL0",101,0) W !,"Count, Non Count, or Both: C//" R SDCONC:DTIME "RTN","SDAL0",102,0) I '$T!(SDCONC="") S SDCONC="C" Q "RTN","SDAL0",103,0) Q:SDCONC=U "RTN","SDAL0",104,0) I $L(SDCONC)=1,$E(SDCONC)="?" W !,"Type C, N or B" G NCOUNT "RTN","SDAL0",105,0) I $E(SDCONC,1,2)="??" D G NCOUNT "RTN","SDAL0",106,0) . W !!,"Choosing ""C"" will limit the selection to COUNT clinics." "RTN","SDAL0",107,0) . W !," ""N"" will limit the selection to NON COUNT clinics." "RTN","SDAL0",108,0) . W !," ""B"" will give BOTH count and non count clinics.",! "RTN","SDAL0",109,0) S SDCONC=$E(SDCONC),SDCONC=$TR(SDCONC,"bcn","BCN") "RTN","SDAL0",110,0) I "BCN"'[SDCONC W !,"C, N or B" G NCOUNT "RTN","SDAL0",111,0) Q "RTN","SDAL0",112,0) ; "RTN","SDAL0",113,0) NCHECK() ;EXTEND $T LOGIC COUNT, NO COUNT,or BOTH "RTN","SDAL0",114,0) N NOC S NOC=$P($G(^SC(SC,0)),U,17) "RTN","SDAL0",115,0) I SDCONC="B" Q 1 "RTN","SDAL0",116,0) I SDCONC="C"&(NOC="N") Q 1 "RTN","SDAL0",117,0) I SDCONC="N"&(NOC="Y") Q 1 "RTN","SDAL0",118,0) Q 0 "RTN","SDAL0",119,0) ; "RTN","SDAL0",120,0) NCLINIC ;SCREEN CLINICS "RTN","SDAL0",121,0) N NOCC "RTN","SDAL0",122,0) I SDCONC="B" S NOCC="&1" "RTN","SDAL0",123,0) I SDCONC="N" S NOCC="&($P(^(0),U,17)=""Y"")" "RTN","SDAL0",124,0) I SDCONC="C" S NOCC="&($P(^(0),U,17)=""N"")" "RTN","SDAL0",125,0) S DIC="^SC(",DIC("S")="I $P(^(0),U,3)=""C""&'$G(^(""OOS""))"_NOCC_"&$S(VAUTD:1,$D(VAUTD(+$P(^(0),U,15))):1,'+$P(^(0),U,15)&$D(VAUTD(+$O(^DG(40.8,0)))):1,1:0)",VAUTSTR="clinic",VAUTVB="VAUTC" G FIRST^VAUTOMA "RTN","SDAL0",126,0) ; "RTN","SDAL0",127,0) ACTIVE() ;Determine if clinic has activity to print "RTN","SDAL0",128,0) ;Output: '1' if activity or selected clinic, '0' otherwise "RTN","SDAL0",129,0) Q:'VAUTC 1 ;selected clinics "RTN","SDAL0",130,0) Q:$O(^SC(SC,"C",SDD,1,0)) 1 ;chart request list "RTN","SDAL0",131,0) ;if clinic has no appts, return 0 "RTN","SDAL0",132,0) S SDX=1 I '$D(^TMP($J,"SDAMA301",SC)) S SDX=0 "RTN","SDAL0",133,0) Q SDX "RTN","SDCIAL") 0^3^B22822282^B22598364 "RTN","SDCIAL",1,0) SDCIAL ;ALB/TMP - INPATIENT APPOINTMENT LIST ;16 JAN 86 "RTN","SDCIAL",2,0) ;;5.3;Scheduling;**32,406,618**;Aug 13, 1993;Build 3 "RTN","SDCIAL",3,0) S DIV="",SDTT=0 D DIV^SDUTL I $T S DIC("A")="INPATIENT APPOINTMENT LIST FOR WHICH DIVISION:" D ASK^SDDIV Q:Y<0 "RTN","SDCIAL",4,0) RD R !,"FOR WARD (TYPE 'ALL' FOR ALL WARDS): ",X:DTIME Q:"^"[X I X?.E1"?" W !,"ENTER A WARD NAME OR ALL FOR ALL WARDS" "RTN","SDCIAL",5,0) S X=$$UP^XLFSTR(X) "RTN","SDCIAL",6,0) I X="ALL" S SDW=X G RD1 "RTN","SDCIAL",7,0) S DIC="^DIC(42,",DIC(0)="EQ" "RTN","SDCIAL",8,0) D ^DIC Q:X=""!(X["^") G:Y<0 RD S SDW=+Y "RTN","SDCIAL",9,0) RD1 D DATE^SDUTL G:POP END I BEGDATE
0 I $D(^DPT(I2,0)) S SDLIST(I2)="" "RTN","SDCIAL",21,0) Q "RTN","SDCIAL",22,0) DFN ;retrieve appt data for list of patients "RTN","SDCIAL",23,0) I $D(SDLIST)'>1 Q "RTN","SDCIAL",24,0) N SDARRAY,SDDFN,SDWARD,SDAPPT,SDCL,SDLAB,SDXRAY,SDEKG,SDOTHER,SDPNDFN "RTN","SDCIAL",25,0) S SDARRAY(1)=BEGDATE_";"_ENDDATE,SDARRAY(3)="I;R",SDARRAY("FLDS")="1;2;6;19;20;21",SDARRAY(4)="SDLIST(" "RTN","SDCIAL",26,0) S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY) I SDCOUNT<1 Q "RTN","SDCIAL",27,0) ;re-sort output by clinic, then patient "RTN","SDCIAL",28,0) S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301",SDDFN)) Q:SDDFN="" D "RTN","SDCIAL",29,0) . S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301",SDDFN,SDCL)) Q:SDCL="" D "RTN","SDCIAL",30,0) .. ;SD*618 Add patient's name to be one of the sort filter (Patient's name~DFN) "RTN","SDCIAL",31,0) .. S SDPNDFN=$P($G(^DPT(SDDFN,0)),"^",1)_"~"_SDDFN "RTN","SDCIAL",32,0) .. M ^TMP($J,"SDAMA301C",SDCL,SDPNDFN)=^TMP($J,"SDAMA301",SDDFN,SDCL) "RTN","SDCIAL",33,0) I DIV'="" D "RTN","SDCIAL",34,0) . ;remove appts if clinic is not in selected division "RTN","SDCIAL",35,0) . S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301C",SDCL)) Q:SDCL="" I $P(^SC(SDCL,0),"^",15)'=DIV K ^TMP($J,"SDAMA301C",SDCL) "RTN","SDCIAL",36,0) ;get appt data and add to ^UTILITY "RTN","SDCIAL",37,0) S SDCL=0 F S SDCL=$O(^TMP($J,"SDAMA301C",SDCL)) Q:SDCL="" D "RTN","SDCIAL",38,0) . S SDDFN=0 F S SDDFN=$O(^TMP($J,"SDAMA301C",SDCL,SDDFN)) Q:SDDFN="" D "RTN","SDCIAL",39,0) .. S SDAPPT=0 F S SDAPPT=$O(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT)) Q:SDAPPT="" D "RTN","SDCIAL",40,0) ... S SDWARD=$P($G(^DPT($P(SDDFN,"~",2),.1)),"^",1) "RTN","SDCIAL",41,0) ... S SDLAB=$P(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT),"^",21) "RTN","SDCIAL",42,0) ... S SDXRAY=$P(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT),"^",20) "RTN","SDCIAL",43,0) ... S SDEKG=$P(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT),"^",19) "RTN","SDCIAL",44,0) ... S SDOTHER=$P($G(^TMP($J,"SDAMA301C",SDCL,SDDFN,SDAPPT,"C")),"^",1) "RTN","SDCIAL",45,0) ... ;mimic DPT "S" node, but also add 'other' to end (6th piece) for future use: "RTN","SDCIAL",46,0) ... I $G(SDWARD)]"" S ^UTILITY($J,SDWARD,SDAPPT\1,SDDFN,"."_$P(SDAPPT,".",2))=SDCL_"^^"_$G(SDLAB)_"^"_$G(SDXRAY)_"^"_$G(SDEKG)_"^"_$G(SDOTHER) "RTN","SDCIAL",47,0) Q "RTN","SDCIAL",48,0) WRT I SDCOUNT<0 W @IOF,?29,"INPATIENT APPOINTMENT LIST",! X "F A=1:1:IOM W ""-""" W !!,$$SDAPIERR^SDAMUTDT() D END Q "RTN","SDCIAL",49,0) S I="" I $O(^UTILITY($J,I))']"" W @IOF,?29,"INPATIENT APPOINTMENT LIST",! X "F A=1:1:IOM W ""-""" W !!,"NO MATCHES FOUND!" G END "RTN","SDCIAL",50,0) S (SDPG,I)=0 F S I=$O(^UTILITY($J,I)) Q:I=""!(SDEND) D HD Q:SDEND S I2=0 F S I2=$O(^UTILITY($J,I,I2)) Q:I2="" D:($Y+4)>IOSL HD Q:SDEND D APPT Q:SDEND "RTN","SDCIAL",51,0) G END "RTN","SDCIAL",52,0) APPT W:SD2 !! D:($Y+6)>IOSL HD Q:SDEND S Y=I2 D DTS^SDUTL W !,Y S SD2=1 "RTN","SDCIAL",53,0) ;SD*618 I3=Patient's Name~DFN "RTN","SDCIAL",54,0) S I3=0 F S I3=$O(^UTILITY($J,I,I2,I3)) Q:I3=""!(SDEND) D:($Y+5)>IOSL HD Q:SDEND W !,?2,$P(I3,"~",1),?34,$P(^DPT($P(I3,"~",2),0),"^",9) S I4=0 F S I4=$O(^UTILITY($J,I,I2,I3,I4)) Q:I4="" D WRTC Q:SDEND "RTN","SDCIAL",55,0) Q "RTN","SDCIAL",56,0) WRTC S SDY=$G(^UTILITY($J,I,I2,I3,I4)) I ($Y+4)>IOSL D HD Q:SDEND W !,?2,$P(I3,"~",1),?34,$P(^DPT($P(I3,"~",2),0),"^",9)," (CONTINUED)" "RTN","SDCIAL",57,0) W !,?5,$P(^SC(+SDY,0),"^",1) S Y=I4,SD2=1 D AT^SDUTL W ?37,$J(Y,8) S SDB=50 F A=3:1:5 S Y="."_$P($P(SDY,"^",A),".",2) D AT^SDUTL W ?SDB,$J(Y,8) S SDB=SDB+10 "RTN","SDCIAL",58,0) ;comments/other "RTN","SDCIAL",59,0) I $P($G(^UTILITY($J,I,I2,I3,I4)),"^",6)]"" W !,?15,$P(^(I4),"^",6) Q "RTN","SDCIAL",60,0) Q "RTN","SDCIAL",61,0) HD I SD1,SDTT D OUT^SDUTL Q:SDEND "RTN","SDCIAL",62,0) S SDPG=SDPG+1,SD1=1 W !,@IOF,!,?29,"INPATIENT APPOINTMENT LIST",?69,"PAGE: ",SDPG,! S SDOS=(77-$L(I))\2 W ?SDOS,"WARD: ",I S Y=DT D DTS^SDUTL W !,?31,"DATE PRINTED: ",Y,!! "RTN","SDCIAL",63,0) W !!,"APPOINTMENT DATE",!,?2,"PATIENT NAME",?34,"SSN",!,?38,"APPOINT",?52,"LAB",?62,"XRAY",?72,"EKG",!,?5,"CLINIC",?38,"TIME" F A=52:10:72 W ?A,"TIME" "RTN","SDCIAL",64,0) W !,?15,"OTHER INFORMATION",! F A=1:1:80 W "-" "RTN","SDCIAL",65,0) S SD2=0 Q "RTN","SDCIAL",66,0) END S:'$D(IOF) IOF="#" W ! W:'SDTT @IOF "RTN","SDCIAL",67,0) K ^TMP($J,"SDAMA301"),^TMP($J,"SDAMA301C") "RTN","SDCIAL",68,0) K ALL,DIV,POP,SDT1,%DT,A,BEGDATE,DFN,DIC,DIV,ENDDATE,I,I1,I2,I3,I4 "RTN","SDCIAL",69,0) K II,SD1,SDB,SDEND,SDOS,SDPG,SDSC,SDTT,SDW,SDXX,SDY,X,Y,SDPNDFN,PGM "RTN","SDCIAL",70,0) K VAR,VAL,SD2 "RTN","SDCIAL",71,0) D CLOSE^DGUTQ,SDIAL^SDKILL "RTN","SDCIAL",72,0) Q "VER") 8.0^22.0 "BLD",9732,6) ^515 **END** **END**