- 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 Feb 19, 2025@00:19 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
