- SDWLRPS1 ;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1-SUMMARY ;1/5/16 3:40pm
- ;;5.3;scheduling;**263,412,645**;AUG 13 1993;Build 7
- ;
- ;
- ;******************************************************************
- ; CHANGE LOG
- ;
- ; DATE PATCH DESCRIPTION
- ; ---- ----- -----------
- ;
- ;
- ;
- ;
- EN ;
- D INIT
- I $$S^%ZTLOAD G END
- D HD
- D SORT
- I $$S^%ZTLOAD G END
- D PRT
- I $D(DUOUT) W !!,"*** End of Report ***" G END
- G:POP END
- I $$S^%ZTLOAD G END
- D PRT1
- W !!,"*** End of Report ***"
- K ^TMP("SDWLRPS1",$J)
- Q
- INIT ;Initialize variables
- ;
- I $D(CT1) S SDWLCT1=CT1
- I $D(CT2) S SDWLCT2=CT2
- I $D(DATE) S SDWLDATE=DATE
- I $D(FORM) S SDWLFORM=FORM
- I $D(INS) S SDWLINS=INS
- I $D(OPEN) S SDWLOPEN=OPEN
- S SDWLPG=0
- I $D(ZTSAVE) D
- .F SDWLI="CT1","CT2","DATE","FORM","INS","OPEN" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI))
- I SDWLINS="ALL" S SDWLIN("ALL")=""
- S SDWLTXP=$P(SDWLCT1,U,3)
- S SDWLOPEN=$S(SDWLOPEN=1:"O",1:"C")
- 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
- I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCT=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCT="" S SDWLCT2(SDWLCT)=""
- I SDWLDATE="ALL" S SDWLBD=0,SDWLED=9999999 G INIT1
- S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2)
- N POP S POP=0 ;SD*5.3*412
- INIT1 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2)
- Q
- SORT ;Sort Records
- K ^TMP("SDWLRPS1",$J)
- S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D
- .S SDWLX=$G(^SDWL(409.3,SDWLDA,0)),SDWLERR=0,SDWLDFN=+SDWLX,SDWLDDT=$P(SDWLX,U,16)
- .;-Check for Institution Sort
- .I SDWLINS'="ALL" D
- ..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q
- .;-Check for Date Range Compliance
- .I $P(SDWLX,U,16)<SDWLBD!($P(SDWLX,U,16)>SDWLED) S SDWLERR=2 Q
- .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
- .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
- .S SDWLF=$P(SDWLCT1,U,2)
- .I SDWLCT2'="ALL" D
- ..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3
- .I SDWLTYP="" S SDWLERR=4 Q
- .I SDWLOPEN'["C",$P(SDWLX,U,17)'[SDWLOPEN S SDWLERR=6 Q
- .Q:SDWLERR D
- ..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
- ..S:'$D(^TMP("SDWLRPS1",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)) ^(SDWLTYPE)=0
- ..S ^TMP("SDWLRPS1",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
- ..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
- ..S:'$D(^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)) ^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=0
- ..S ^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
- ..S ^TMP("SDWLRPS1",$J,"D",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE,+SDWLDWT,SDWLDA)=""
- Q
- PRT ;
- I '$D(^TMP("SDWLRPS1",$J,"A")) W !!,"*** No Patients to Report ***" S DUOUT="" Q
- 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
- .D PRA
- Q
- PRA ;
- S SDWLSC=0,(SDWLX,SDWLXT)=0 F S SDWLSC=$O(^TMP("SDWLRPS1",$J,"A",SDWLIN,SDWLSC)) Q:SDWLSC="" D
- .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
- .S SDWLXTT=0,SDWLDFNX=0 F S SDWLDFNX=$O(^TMP("SDWLRPS1",$J,"B",SDWLIN,SDWLSC,SDWLDFNX)) Q:SDWLDFNX="" S SDWLXTT=SDWLXTT+1
- W !,?20,"Total #: ",SDWLXT
- I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR S:X="^" POP=1 Q:POP ;SD*5.3*412 early exit
- Q
- PRT1 ;
- N DFN
- D HD1
- 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
- .W !,"******* ",SDWLSCC," *******",!
- .S SDWLINS=0 F S SDWLINS=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS)) Q:SDWLINS="" D Q:POP W ! ;SD*5.3*412
- ..W !,$P($G(^DIC(4,SDWLINS,0)),U,1)
- ..S SDWLSC=0 F S SDWLSC=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC)) Q:SDWLSC="" D Q:POP ;SD*5.3*412
- ...W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1))
- ...S SDWLWT="" F S SDWLWT=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT)) Q:SDWLWT="" D Q:POP ;SD*5.3*412
- ....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
- .....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
- ......D DEM^VADPT,1^VADPT K DFN
- ......W !,VA("BID"),?6,$E(VADM(1),1,25) W ?32,$E(SDWLODT,4,5),"/",$E(SDWLODT,6,7),"/",($E(SDWLODT,1,3)+1700)
- ......W ?47,$E(SDWLDDT,4,5),"/",$E(SDWLDDT,6,7),"/",($E(SDWLDDT,1,3)+1700),?60,$J(SDWLWT,5)
- ......I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR S:X="^" POP=1 Q:POP D HD1
- ......I $Y>IOSL D HD
- .W !
- LINE ;Draw Line
- W !,"_______________________________________________________________________________"
- Q
- HD ;Header
- W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report"
- S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG
- W !!,?30,"Institution: " I SDWLINS="ALL" D
- .W ?45,SDWLINS
- F I=1:1 S X=$P($P(SDWLINS,";",I),"^",2) Q:X="" W:I>1 ! W ?45,X
- S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBDT=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLEDT=Y
- ; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date'
- ;W !,?23,"Date Desired Range: ",SDWLBDT," to ",SDWLEDT
- W !,?18,"CID/Preferred Date Range: ",SDWLBDT," to ",SDWLEDT
- S X=$P(SDWLCT2,U,2)
- W !?27,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL"
- I X'="ALL" D
- .F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$$EXTERNAL^DILFD(SDWLF,.01,,X)
- S X=$G(SDWLOPEN) W !,?36,"Status: ",$S(SDWLOPEN="O":"Open",1:"All")
- S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed")
- W !
- Q
- HD1 ;
- W:$D(IOF) @IOF
- ; SD*5.3*645 - replaced 'Date Desired' with 'CID/PD' and adjusted format
- ;W !!,"Name",?30,"Date Entered",?45,"Date Desired",?60,"# of Days Waiting",!
- W !!,"Name",?30,"Date Entered",?47,"CID/PD",?60,"# of Days Waiting",!
- END K X1,X2,CT1,CT2,DATE,I,INS,OPEN,FORM
- K ^TMP("SDWLRPT1",$J) Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLRPS1 6442 printed Feb 19, 2025@00:29:47 Page 2
- SDWLRPS1 ;IOFO BAY PINES/TEH - WAIT LIST REPORT FORMAT 1-SUMMARY ;1/5/16 3:40pm
- +1 ;;5.3;scheduling;**263,412,645**;AUG 13 1993;Build 7
- +2 ;
- +3 ;
- +4 ;******************************************************************
- +5 ; CHANGE LOG
- +6 ;
- +7 ; DATE PATCH DESCRIPTION
- +8 ; ---- ----- -----------
- +9 ;
- +10 ;
- +11 ;
- +12 ;
- EN ;
- +1 DO INIT
- +2 IF $$S^%ZTLOAD
- GOTO END
- +3 DO HD
- +4 DO SORT
- +5 IF $$S^%ZTLOAD
- GOTO END
- +6 DO PRT
- +7 IF $DATA(DUOUT)
- WRITE !!,"*** End of Report ***"
- GOTO END
- +8 if POP
- GOTO END
- +9 IF $$S^%ZTLOAD
- GOTO END
- +10 DO PRT1
- +11 WRITE !!,"*** End of Report ***"
- +12 KILL ^TMP("SDWLRPS1",$JOB)
- +13 QUIT
- INIT ;Initialize variables
- +1 ;
- +2 IF $DATA(CT1)
- SET SDWLCT1=CT1
- +3 IF $DATA(CT2)
- SET SDWLCT2=CT2
- +4 IF $DATA(DATE)
- SET SDWLDATE=DATE
- +5 IF $DATA(FORM)
- SET SDWLFORM=FORM
- +6 IF $DATA(INS)
- SET SDWLINS=INS
- +7 IF $DATA(OPEN)
- SET SDWLOPEN=OPEN
- +8 SET SDWLPG=0
- +9 IF $DATA(ZTSAVE)
- Begin DoDot:1
- +10 FOR SDWLI="CT1","CT2","DATE","FORM","INS","OPEN"
- SET SDWL="SDWL"_SDWLI
- SET @SDWL=$GET(ZTSAVE(SDWLI))
- End DoDot:1
- +11 IF SDWLINS="ALL"
- SET SDWLIN("ALL")=""
- +12 SET SDWLTXP=$PIECE(SDWLCT1,U,3)
- +13 SET SDWLOPEN=$SELECT(SDWLOPEN=1:"O",1:"C")
- +14 IF SDWLINS'="ALL"
- FOR SDWLI=1:1
- SET SDWLIN=$PIECE($PIECE(SDWLINS,";",SDWLI),U,1)
- if SDWLIN=""
- QUIT
- SET SDWLIN(SDWLIN)=""
- SET ^TMP("SDWLRPT1",$JOB,$PIECE(^DIC(4,SDWLIN,0),U,1))=0
- +15 IF SDWLCT2'="ALL"
- FOR SDWLI=1:1
- SET SDWLCT=$PIECE($PIECE(SDWLCT2,";",SDWLI),U,1)
- if SDWLCT=""
- QUIT
- SET SDWLCT2(SDWLCT)=""
- +16 IF SDWLDATE="ALL"
- SET SDWLBD=0
- SET SDWLED=9999999
- GOTO INIT1
- +17 SET SDWLBD=$PIECE(SDWLDATE,U,1)
- SET SDWLED=$PIECE(SDWLDATE,U,2)
- +18 ;SD*5.3*412
- NEW POP
- SET POP=0
- INIT1 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET SDWLDTP=$PIECE(Y,":",1,2)
- +1 QUIT
- SORT ;Sort Records
- +1 KILL ^TMP("SDWLRPS1",$JOB)
- +2 SET SDWLDA=0
- FOR
- SET SDWLDA=$ORDER(^SDWL(409.3,SDWLDA))
- if SDWLDA<1
- QUIT
- Begin DoDot:1
- +3 SET SDWLX=$GET(^SDWL(409.3,SDWLDA,0))
- SET SDWLERR=0
- SET SDWLDFN=+SDWLX
- SET SDWLDDT=$PIECE(SDWLX,U,16)
- +4 ;-Check for Institution Sort
- +5 IF SDWLINS'="ALL"
- Begin DoDot:2
- +6 IF '$DATA(SDWLIN(+$PIECE(SDWLX,U,3)))
- SET SDWLERR=1
- QUIT
- End DoDot:2
- +7 ;-Check for Date Range Compliance
- +8 IF $PIECE(SDWLX,U,16)<SDWLBD!($PIECE(SDWLX,U,16)>SDWLED)
- SET SDWLERR=2
- QUIT
- +9 SET SDWLAPDT=$PIECE(SDWLX,U,16)
- SET SDWLOPDT=$PIECE(SDWLX,U,2)
- SET X1=DT
- SET X2=SDWLAPDT
- DO ^%DTC
- SET SDWLDWT=X
- IF SDWLDWT<0
- SET SDWLDWT=0
- +10 SET SDWLTYP=$PIECE(SDWLCT1,U,1)
- SET SDWLTYPE=$SELECT(SDWLTYP="C":$PIECE(SDWLX,U,9),1:$PIECE(SDWLX,U,8))
- IF SDWLTYPE=""
- SET SDWLERR=7
- QUIT
- +11 SET SDWLF=$PIECE(SDWLCT1,U,2)
- +12 IF SDWLCT2'="ALL"
- Begin DoDot:2
- +13 IF '$DATA(SDWLCT2(SDWLTYPE))
- SET SDWLERR=3
- End DoDot:2
- +14 IF SDWLTYP=""
- SET SDWLERR=4
- QUIT
- +15 IF SDWLOPEN'["C"
- IF $PIECE(SDWLX,U,17)'[SDWLOPEN
- SET SDWLERR=6
- QUIT
- +16 if SDWLERR
- QUIT
- Begin DoDot:2
- +17 SET SDWLSCC=2
- SET DFN=SDWLDFN
- DO ELIG^VADPT
- IF $DATA(VAEL(3))
- SET SDWLSCN=$PIECE(VAEL(3),U,2)
- IF SDWLSCN>49
- SET SDWLSCC=1
- +18 if '$DATA(^TMP("SDWLRPS1",$JOB,"A",+$PIECE(SDWLX,U,3),SDWLTYPE))
- SET ^(SDWLTYPE)=0
- +19 SET ^TMP("SDWLRPS1",$JOB,"A",+$PIECE(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
- +20 if '$DATA(^TMP("SDWLRPS1",$JOB,"B",+$PIECE(SDWLX,U,3),SDWLTYPE,SDWLDFN))
- SET ^(SDWLDFN)=0
- SET ^TMP("SDWLRPS1",$JOB,"B",+$PIECE(SDWLX,U,3),SDWLTYPE,SDWLDFN)=^(SDWLDFN)+1
- +21 if '$DATA(^TMP("SDWLRPS1",$JOB,"C",SDWLSCC,+$PIECE(SDWLX,U,3),SDWLTYPE))
- SET ^TMP("SDWLRPS1",$JOB,"C",SDWLSCC,+$PIECE(SDWLX,U,3),SDWLTYPE)=0
- +22 SET ^TMP("SDWLRPS1",$JOB,"C",SDWLSCC,+$PIECE(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
- +23 SET ^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,+$PIECE(SDWLX,U,3),SDWLTYPE,+SDWLDWT,SDWLDA)=""
- End DoDot:2
- End DoDot:1
- +24 QUIT
- PRT ;
- +1 IF '$DATA(^TMP("SDWLRPS1",$JOB,"A"))
- WRITE !!,"*** No Patients to Report ***"
- SET DUOUT=""
- QUIT
- +2 ;SD*5.3*412
- SET SDWLIN=0
- FOR
- SET SDWLIN=$ORDER(^TMP("SDWLRPS1",$JOB,"A",SDWLIN))
- if SDWLIN=""
- QUIT
- WRITE !,"Institution: ",$PIECE($GET(^DIC(4,SDWLIN,0)),U,1),!
- Begin DoDot:1
- +3 DO PRA
- End DoDot:1
- if POP
- QUIT
- +4 QUIT
- PRA ;
- +1 SET SDWLSC=0
- SET (SDWLX,SDWLXT)=0
- FOR
- SET SDWLSC=$ORDER(^TMP("SDWLRPS1",$JOB,"A",SDWLIN,SDWLSC))
- if SDWLSC=""
- QUIT
- Begin DoDot:1
- +2 SET SDWLX=$GET(^TMP("SDWLRPS1",$JOB,"A",SDWLIN,SDWLSC))
- SET SDWLXT=SDWLXT+SDWLX
- WRITE !,$$EXTERNAL^DILFD(SDWLF,.01,,$PIECE(^SDWL(SDWLF,SDWLSC,0),U,1)),?30,SDWLX
- +3 SET SDWLXTT=0
- SET SDWLDFNX=0
- FOR
- SET SDWLDFNX=$ORDER(^TMP("SDWLRPS1",$JOB,"B",SDWLIN,SDWLSC,SDWLDFNX))
- if SDWLDFNX=""
- QUIT
- SET SDWLXTT=SDWLXTT+1
- End DoDot:1
- +4 WRITE !,?20,"Total #: ",SDWLXT
- +5 ;SD*5.3*412 early exit
- IF $DATA(SDWLSPT)
- IF $Y>IOSL
- SET DIR(0)="E"
- DO ^DIR
- if X="^"
- SET POP=1
- if POP
- QUIT
- +6 QUIT
- PRT1 ;
- +1 NEW DFN
- +2 DO HD1
- +3 ;SD*5.3*412 added to allow early exit
- SET SDWLSCC=0
- FOR
- SET SDWLSCC=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC))
- if SDWLSCC=""
- QUIT
- if $$S^%ZTLOAD
- QUIT
- Begin DoDot:1
- +4 WRITE !,"******* ",SDWLSCC," *******",!
- +5 ;SD*5.3*412
- SET SDWLINS=0
- FOR
- SET SDWLINS=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,SDWLINS))
- if SDWLINS=""
- QUIT
- Begin DoDot:2
- +6 WRITE !,$PIECE($GET(^DIC(4,SDWLINS,0)),U,1)
- +7 ;SD*5.3*412
- SET SDWLSC=0
- FOR
- SET SDWLSC=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,SDWLINS,SDWLSC))
- if SDWLSC=""
- QUIT
- Begin DoDot:3
- +8 WRITE !,$$EXTERNAL^DILFD(SDWLF,.01,,$PIECE(^SDWL(SDWLF,SDWLSC,0),U,1))
- +9 ;SD*5.3*412
- SET SDWLWT=""
- FOR
- SET SDWLWT=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT))
- if SDWLWT=""
- QUIT
- Begin DoDot:4
- +10 ;SD*5.3*412
- SET SDWLDA=0
- FOR
- SET SDWLDA=$ORDER(^TMP("SDWLRPS1",$JOB,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT,SDWLDA))
- if SDWLDA=""
- QUIT
- Begin DoDot:5
- +11 ;SD*5.3*412
- SET X=$GET(^SDWL(409.3,SDWLDA,0))
- SET SDWLODT=$PIECE(X,U,2)
- SET SDWLDDT=$PIECE(X,U,16)
- SET DFN=+X
- Begin DoDot:6
- +12 DO DEM^VADPT
- DO 1^VADPT
- KILL DFN
- +13 WRITE !,VA("BID"),?6,$EXTRACT(VADM(1),1,25)
- WRITE ?32,$EXTRACT(SDWLODT,4,5),"/",$EXTRACT(SDWLODT,6,7),"/",($EXTRACT(SDWLODT,1,3)+1700)
- +14 WRITE ?47,$EXTRACT(SDWLDDT,4,5),"/",$EXTRACT(SDWLDDT,6,7),"/",($EXTRACT(SDWLDDT,1,3)+1700),?60,$JUSTIFY(SDWLWT,5)
- +15 IF $DATA(SDWLSPT)
- IF $Y>IOSL
- SET DIR(0)="E"
- DO ^DIR
- if X="^"
- SET POP=1
- if POP
- QUIT
- DO HD1
- +16 IF $Y>IOSL
- DO HD
- End DoDot:6
- if POP
- QUIT
- End DoDot:5
- if POP
- QUIT
- End DoDot:4
- if POP
- QUIT
- End DoDot:3
- if POP
- QUIT
- End DoDot:2
- if POP
- QUIT
- WRITE !
- +17 WRITE !
- End DoDot:1
- if POP
- QUIT
- LINE ;Draw Line
- +1 WRITE !,"_______________________________________________________________________________"
- +2 QUIT
- HD ;Header
- +1 if $DATA(IOF)
- WRITE @IOF
- WRITE !,SDWLDTP,?80-$LENGTH("Appointment Wait List Report")\2,"Appointment Wait List Report"
- +2 SET SDWLPG=SDWLPG+1
- WRITE ?72,"Page: ",SDWLPG
- +3 WRITE !!,?30,"Institution: "
- IF SDWLINS="ALL"
- Begin DoDot:1
- +4 WRITE ?45,SDWLINS
- End DoDot:1
- +5 FOR I=1:1
- SET X=$PIECE($PIECE(SDWLINS,";",I),"^",2)
- if X=""
- QUIT
- if I>1
- WRITE !
- WRITE ?45,X
- +6 SET Y=$PIECE(SDWLDATE,U,1)
- DO DD^%DT
- SET SDWLBDT=Y
- SET Y=$PIECE(SDWLDATE,U,2)
- DO DD^%DT
- SET SDWLEDT=Y
- +7 ; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date'
- +8 ;W !,?23,"Date Desired Range: ",SDWLBDT," to ",SDWLEDT
- +9 WRITE !,?18,"CID/Preferred Date Range: ",SDWLBDT," to ",SDWLEDT
- +10 SET X=$PIECE(SDWLCT2,U,2)
- +11 WRITE !?27,"Report Category: ",$SELECT($PIECE(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY")
- IF X="ALL"
- WRITE " ALL"
- +12 IF X'="ALL"
- Begin DoDot:1
- +13 FOR I=1:1
- SET X=$PIECE($PIECE(SDWLCT2,";",I),"^",2)
- if X=""
- QUIT
- WRITE !,?45,$$EXTERNAL^DILFD(SDWLF,.01,,X)
- End DoDot:1
- +14 SET X=$GET(SDWLOPEN)
- WRITE !,?36,"Status: ",$SELECT(SDWLOPEN="O":"Open",1:"All")
- +15 SET X=$GET(SDWLFORM)
- WRITE !,?28,"Output Format: ",$SELECT(SDWLFORM="S":"Summary",1:"Detailed")
- +16 WRITE !
- +17 QUIT
- HD1 ;
- +1 if $DATA(IOF)
- WRITE @IOF
- +2 ; SD*5.3*645 - replaced 'Date Desired' with 'CID/PD' and adjusted format
- +3 ;W !!,"Name",?30,"Date Entered",?45,"Date Desired",?60,"# of Days Waiting",!
- +4 WRITE !!,"Name",?30,"Date Entered",?47,"CID/PD",?60,"# of Days Waiting",!
- END KILL X1,X2,CT1,CT2,DATE,I,INS,OPEN,FORM
- +1 KILL ^TMP("SDWLRPT1",$JOB)
- QUIT
- +2 ;