SDECRPT1 ;ALB/JSM - SCHEDULING ENHANCEMENTS CLINIC REPORTS ;MAR 15, 2017
;;5.3;Scheduling;**658**;Aug 13, 1993;Build 23
;
N %ZIS,CLLST,DIC,DTOUT,POP,X,Y,ZTRTN
;Get the clinics
RD S DIC="^SC(",DIC(0)="AEMQZ",DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))",DIC("A")="Select CLINIC: " D ^DIC K DIC("S"),DIC("A") I X="",$D(CLLST) G GETDEV
I $S(X["^":1,'$D(DTOUT):0,$D(DTOUT)&DTOUT:1,1:0) G END
I $D(CLLST(+Y)) W !,*7,"This clinic has already been selected" G RD
S CLLST(+Y)=$P(Y,U,2) G RD
;
GETDEV ;get device to print to
S %ZIS="Q" D ^%ZIS G:POP END
I $D(IO("Q")) S ZTRTN="GETDATA^SDECRPT1" D ^%ZTLOAD,HOME^%ZIS G END
;
GETDATA ;
;
N CNT,LST,SDT,SDRIEN,SDREQ,SDCL,SDCLN,SDPT,FIELDS,PTDATA,PTERR,CLHEAD
N COPEN,SDYN,SDCANCEL
S (CNT,COPEN,SDCANCEL)=0
S SDCANCEL=$O(^DIC(19,"B","SDCANCEL",SDCANCEL))
;setup ^TMP
K ^TMP("SDECRPT1",$J)
;Loop through SDEC APPT REQUEST for 'Open' requests
S (SDT,SDRIEN)="" F S SDT=$O(^SDEC(409.85,"E","O",SDT)) Q:SDT="" D
.F S SDRIEN=$O(^SDEC(409.85,"E","O",SDT,SDRIEN)) Q:SDRIEN="" D
..S SDREQ=^SDEC(409.85,SDRIEN,0),SDCL=$P(SDREQ,U,9),COPEN=0
..I SDCL'="",$D(CLLST(SDCL)) D CKAUDIT ;chk if clinic was selected & reopened using SDCANCEL
..I COPEN D
...S SDPT=$P(SDREQ,U,1) ;get patient IEN
...K PTDATA,PTERR S FIELDS=".01;.09;.131"
...D GETS^DIQ(2,SDPT,FIELDS,"IE","PTDATA","PTERR")
...S CNT=CNT+1 S ^TMP("SDECRPT1",$J,CLLST(SDCL),CNT)=PTDATA(2,SDPT_",",.01,"E")_"^"_PTDATA(2,SDPT_",",.09,"E")_"^"_PTDATA(2,SDPT_",",.131,"E")_"^"_$$FMTE^XLFDT($P(SDREQ,U,16))
D CLLIST(.LST,.CLLST) ;create list of clinics for Report Heading
U IO
W !,"VS GUI Requests Re-Opened by Cancel Availability (SDCANCEL) Option"
W !," for clinics: "_LST
W !
W !
W !,?2,"PATIENT",?34,"SSN",?45,"TELEPHONE",?66,"CID/PREF DATE",!
;print out the data
S (CLHEAD,SDCLN)="" F S SDCLN=$O(^TMP("SDECRPT1",$J,SDCLN)) Q:SDCLN="" D
.I CLHEAD'=SDCLN S CLHEAD=SDCLN W !,SDCLN
.S CNT=0 F S CNT=$O(^TMP("SDECRPT1",$J,SDCLN,CNT)) Q:CNT="" D
..W !,?2,$P(^(CNT),U,1),?34,$P(^(CNT),U,2),?45,$P(^(CNT),U,3),?66,$P(^(CNT),U,4)
G END
;
CLLIST(RET,ARRAY) ;
S (RET,X)="" F S X=$O(ARRAY(X)) Q:X="" D
.S RET=RET_ARRAY(X)_", "
S RET=$E(RET,1,*-2)
Q
;
CKAUDIT ;
N AIEN
S (AIEN,COPEN)=0
F S AIEN=$O(^DIA(409.85,"B",SDRIEN,AIEN)) Q:AIEN="" D Q:COPEN
.S:$P($G(^DIA(409.85,AIEN,4.1)),U,1)=SDCANCEL COPEN=1
Q
;
END ; Exit
K ^TMP("SDECRPT1",$J)
K SDT,SDRIEN,SDREQ,SDCL,SDCLN,CLLST,SDPT,FIELDS,PTDATA,PTERR
D KILL^%ZTLOAD
D ^%ZISC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECRPT1 2540 printed Apr 09, 2024@21:54:13 Page 2
SDECRPT1 ;ALB/JSM - SCHEDULING ENHANCEMENTS CLINIC REPORTS ;MAR 15, 2017
+1 ;;5.3;Scheduling;**658**;Aug 13, 1993;Build 23
+2 ;
+3 NEW %ZIS,CLLST,DIC,DTOUT,POP,X,Y,ZTRTN
+4 ;Get the clinics
RD SET DIC="^SC("
SET DIC(0)="AEMQZ"
SET DIC("S")="I $P(^(0),""^"",3)=""C"",'$G(^(""OOS""))"
SET DIC("A")="Select CLINIC: "
DO ^DIC
KILL DIC("S"),DIC("A")
IF X=""
IF $DATA(CLLST)
GOTO GETDEV
+1 IF $SELECT(X["^":1,'$DATA(DTOUT):0,$DATA(DTOUT)&DTOUT:1,1:0)
GOTO END
+2 IF $DATA(CLLST(+Y))
WRITE !,*7,"This clinic has already been selected"
GOTO RD
+3 SET CLLST(+Y)=$PIECE(Y,U,2)
GOTO RD
+4 ;
GETDEV ;get device to print to
+1 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO END
+2 IF $DATA(IO("Q"))
SET ZTRTN="GETDATA^SDECRPT1"
DO ^%ZTLOAD
DO HOME^%ZIS
GOTO END
+3 ;
GETDATA ;
+1 ;
+2 NEW CNT,LST,SDT,SDRIEN,SDREQ,SDCL,SDCLN,SDPT,FIELDS,PTDATA,PTERR,CLHEAD
+3 NEW COPEN,SDYN,SDCANCEL
+4 SET (CNT,COPEN,SDCANCEL)=0
+5 SET SDCANCEL=$ORDER(^DIC(19,"B","SDCANCEL",SDCANCEL))
+6 ;setup ^TMP
+7 KILL ^TMP("SDECRPT1",$JOB)
+8 ;Loop through SDEC APPT REQUEST for 'Open' requests
+9 SET (SDT,SDRIEN)=""
FOR
SET SDT=$ORDER(^SDEC(409.85,"E","O",SDT))
if SDT=""
QUIT
Begin DoDot:1
+10 FOR
SET SDRIEN=$ORDER(^SDEC(409.85,"E","O",SDT,SDRIEN))
if SDRIEN=""
QUIT
Begin DoDot:2
+11 SET SDREQ=^SDEC(409.85,SDRIEN,0)
SET SDCL=$PIECE(SDREQ,U,9)
SET COPEN=0
+12 ;chk if clinic was selected & reopened using SDCANCEL
IF SDCL'=""
IF $DATA(CLLST(SDCL))
DO CKAUDIT
+13 IF COPEN
Begin DoDot:3
+14 ;get patient IEN
SET SDPT=$PIECE(SDREQ,U,1)
+15 KILL PTDATA,PTERR
SET FIELDS=".01;.09;.131"
+16 DO GETS^DIQ(2,SDPT,FIELDS,"IE","PTDATA","PTERR")
+17 SET CNT=CNT+1
SET ^TMP("SDECRPT1",$JOB,CLLST(SDCL),CNT)=PTDATA(2,SDPT_",",.01,"E")_"^"_PTDATA(2,SDPT_",",.09,"E")_"^"_PTDATA(2,SDPT_",",.131,"E")_"^"_$$FMTE^XLFDT($PIECE(SDREQ,U,16))
End DoDot:3
End DoDot:2
End DoDot:1
+18 ;create list of clinics for Report Heading
DO CLLIST(.LST,.CLLST)
+19 USE IO
+20 WRITE !,"VS GUI Requests Re-Opened by Cancel Availability (SDCANCEL) Option"
+21 WRITE !," for clinics: "_LST
+22 WRITE !
+23 WRITE !
+24 WRITE !,?2,"PATIENT",?34,"SSN",?45,"TELEPHONE",?66,"CID/PREF DATE",!
+25 ;print out the data
+26 SET (CLHEAD,SDCLN)=""
FOR
SET SDCLN=$ORDER(^TMP("SDECRPT1",$JOB,SDCLN))
if SDCLN=""
QUIT
Begin DoDot:1
+27 IF CLHEAD'=SDCLN
SET CLHEAD=SDCLN
WRITE !,SDCLN
+28 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("SDECRPT1",$JOB,SDCLN,CNT))
if CNT=""
QUIT
Begin DoDot:2
+29 WRITE !,?2,$PIECE(^(CNT),U,1),?34,$PIECE(^(CNT),U,2),?45,$PIECE(^(CNT),U,3),?66,$PIECE(^(CNT),U,4)
End DoDot:2
End DoDot:1
+30 GOTO END
+31 ;
CLLIST(RET,ARRAY) ;
+1 SET (RET,X)=""
FOR
SET X=$ORDER(ARRAY(X))
if X=""
QUIT
Begin DoDot:1
+2 SET RET=RET_ARRAY(X)_", "
End DoDot:1
+3 SET RET=$EXTRACT(RET,1,*-2)
+4 QUIT
+5 ;
CKAUDIT ;
+1 NEW AIEN
+2 SET (AIEN,COPEN)=0
+3 FOR
SET AIEN=$ORDER(^DIA(409.85,"B",SDRIEN,AIEN))
if AIEN=""
QUIT
Begin DoDot:1
+4 if $PIECE($GET(^DIA(409.85,AIEN,4.1)),U,1)=SDCANCEL
SET COPEN=1
End DoDot:1
if COPEN
QUIT
+5 QUIT
+6 ;
END ; Exit
+1 KILL ^TMP("SDECRPT1",$JOB)
+2 KILL SDT,SDRIEN,SDREQ,SDCL,SDCLN,CLLST,SDPT,FIELDS,PTDATA,PTERR
+3 DO KILL^%ZTLOAD
+4 DO ^%ZISC
+5 QUIT
