Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDWLRPS1

SDWLRPS1.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ;******************************************************************
  1. ; CHANGE LOG
  1. ;
  1. ; DATE PATCH DESCRIPTION
  1. ; ---- ----- -----------
  1. ;
  1. ;
  1. ;
  1. ;
  1. EN ;
  1. D INIT
  1. I $$S^%ZTLOAD G END
  1. D HD
  1. D SORT
  1. I $$S^%ZTLOAD G END
  1. D PRT
  1. I $D(DUOUT) W !!,"*** End of Report ***" G END
  1. G:POP END
  1. I $$S^%ZTLOAD G END
  1. D PRT1
  1. W !!,"*** End of Report ***"
  1. K ^TMP("SDWLRPS1",$J)
  1. Q
  1. INIT ;Initialize variables
  1. ;
  1. I $D(CT1) S SDWLCT1=CT1
  1. I $D(CT2) S SDWLCT2=CT2
  1. I $D(DATE) S SDWLDATE=DATE
  1. I $D(FORM) S SDWLFORM=FORM
  1. I $D(INS) S SDWLINS=INS
  1. I $D(OPEN) S SDWLOPEN=OPEN
  1. S SDWLPG=0
  1. I $D(ZTSAVE) D
  1. .F SDWLI="CT1","CT2","DATE","FORM","INS","OPEN" S SDWL="SDWL"_SDWLI,@SDWL=$G(ZTSAVE(SDWLI))
  1. I SDWLINS="ALL" S SDWLIN("ALL")=""
  1. S SDWLTXP=$P(SDWLCT1,U,3)
  1. S SDWLOPEN=$S(SDWLOPEN=1:"O",1:"C")
  1. 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
  1. I SDWLCT2'="ALL" F SDWLI=1:1 S SDWLCT=$P($P(SDWLCT2,";",SDWLI),U,1) Q:SDWLCT="" S SDWLCT2(SDWLCT)=""
  1. I SDWLDATE="ALL" S SDWLBD=0,SDWLED=9999999 G INIT1
  1. S SDWLBD=$P(SDWLDATE,U,1),SDWLED=$P(SDWLDATE,U,2)
  1. N POP S POP=0 ;SD*5.3*412
  1. INIT1 D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=$P(Y,":",1,2)
  1. Q
  1. SORT ;Sort Records
  1. K ^TMP("SDWLRPS1",$J)
  1. S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D
  1. .S SDWLX=$G(^SDWL(409.3,SDWLDA,0)),SDWLERR=0,SDWLDFN=+SDWLX,SDWLDDT=$P(SDWLX,U,16)
  1. .;-Check for Institution Sort
  1. .I SDWLINS'="ALL" D
  1. ..I '$D(SDWLIN(+$P(SDWLX,U,3))) S SDWLERR=1 Q
  1. .;-Check for Date Range Compliance
  1. .I $P(SDWLX,U,16)<SDWLBD!($P(SDWLX,U,16)>SDWLED) S SDWLERR=2 Q
  1. .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
  1. .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
  1. .S SDWLF=$P(SDWLCT1,U,2)
  1. .I SDWLCT2'="ALL" D
  1. ..I '$D(SDWLCT2(SDWLTYPE)) S SDWLERR=3
  1. .I SDWLTYP="" S SDWLERR=4 Q
  1. .I SDWLOPEN'["C",$P(SDWLX,U,17)'[SDWLOPEN S SDWLERR=6 Q
  1. .Q:SDWLERR D
  1. ..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
  1. ..S:'$D(^TMP("SDWLRPS1",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)) ^(SDWLTYPE)=0
  1. ..S ^TMP("SDWLRPS1",$J,"A",+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
  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
  1. ..S:'$D(^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)) ^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=0
  1. ..S ^TMP("SDWLRPS1",$J,"C",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE)=^(SDWLTYPE)+1
  1. ..S ^TMP("SDWLRPS1",$J,"D",SDWLSCC,+$P(SDWLX,U,3),SDWLTYPE,+SDWLDWT,SDWLDA)=""
  1. Q
  1. PRT ;
  1. I '$D(^TMP("SDWLRPS1",$J,"A")) W !!,"*** No Patients to Report ***" S DUOUT="" Q
  1. 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
  1. .D PRA
  1. Q
  1. PRA ;
  1. S SDWLSC=0,(SDWLX,SDWLXT)=0 F S SDWLSC=$O(^TMP("SDWLRPS1",$J,"A",SDWLIN,SDWLSC)) Q:SDWLSC="" D
  1. .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
  1. .S SDWLXTT=0,SDWLDFNX=0 F S SDWLDFNX=$O(^TMP("SDWLRPS1",$J,"B",SDWLIN,SDWLSC,SDWLDFNX)) Q:SDWLDFNX="" S SDWLXTT=SDWLXTT+1
  1. W !,?20,"Total #: ",SDWLXT
  1. I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR S:X="^" POP=1 Q:POP ;SD*5.3*412 early exit
  1. Q
  1. PRT1 ;
  1. N DFN
  1. D HD1
  1. 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
  1. .W !,"******* ",SDWLSCC," *******",!
  1. .S SDWLINS=0 F S SDWLINS=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS)) Q:SDWLINS="" D Q:POP W ! ;SD*5.3*412
  1. ..W !,$P($G(^DIC(4,SDWLINS,0)),U,1)
  1. ..S SDWLSC=0 F S SDWLSC=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC)) Q:SDWLSC="" D Q:POP ;SD*5.3*412
  1. ...W !,$$EXTERNAL^DILFD(SDWLF,.01,,$P(^SDWL(SDWLF,SDWLSC,0),U,1))
  1. ...S SDWLWT="" F S SDWLWT=$O(^TMP("SDWLRPS1",$J,"D",SDWLSCC,SDWLINS,SDWLSC,SDWLWT)) Q:SDWLWT="" D Q:POP ;SD*5.3*412
  1. ....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
  1. .....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
  1. ......D DEM^VADPT,1^VADPT K DFN
  1. ......W !,VA("BID"),?6,$E(VADM(1),1,25) W ?32,$E(SDWLODT,4,5),"/",$E(SDWLODT,6,7),"/",($E(SDWLODT,1,3)+1700)
  1. ......W ?47,$E(SDWLDDT,4,5),"/",$E(SDWLDDT,6,7),"/",($E(SDWLDDT,1,3)+1700),?60,$J(SDWLWT,5)
  1. ......I $D(SDWLSPT),$Y>IOSL S DIR(0)="E" D ^DIR S:X="^" POP=1 Q:POP D HD1
  1. ......I $Y>IOSL D HD
  1. .W !
  1. LINE ;Draw Line
  1. W !,"_______________________________________________________________________________"
  1. Q
  1. HD ;Header
  1. W:$D(IOF) @IOF W !,SDWLDTP,?80-$L("Appointment Wait List Report")\2,"Appointment Wait List Report"
  1. S SDWLPG=SDWLPG+1 W ?72,"Page: ",SDWLPG
  1. W !!,?30,"Institution: " I SDWLINS="ALL" D
  1. .W ?45,SDWLINS
  1. F I=1:1 S X=$P($P(SDWLINS,";",I),"^",2) Q:X="" W:I>1 ! W ?45,X
  1. S Y=$P(SDWLDATE,U,1) D DD^%DT S SDWLBDT=Y S Y=$P(SDWLDATE,U,2) D DD^%DT S SDWLEDT=Y
  1. ; SD*5.3*645 - replaced 'Date Desired' with 'CID/Preferred Date'
  1. ;W !,?23,"Date Desired Range: ",SDWLBDT," to ",SDWLEDT
  1. W !,?18,"CID/Preferred Date Range: ",SDWLBDT," to ",SDWLEDT
  1. S X=$P(SDWLCT2,U,2)
  1. W !?27,"Report Category: ",$S($P(SDWLCT1,U,1)="C":"CLINIC",1:"SPECIALTY") I X="ALL" W " ALL"
  1. I X'="ALL" D
  1. .F I=1:1 S X=$P($P(SDWLCT2,";",I),"^",2) Q:X="" W !,?45,$$EXTERNAL^DILFD(SDWLF,.01,,X)
  1. S X=$G(SDWLOPEN) W !,?36,"Status: ",$S(SDWLOPEN="O":"Open",1:"All")
  1. S X=$G(SDWLFORM) W !,?28,"Output Format: ",$S(SDWLFORM="S":"Summary",1:"Detailed")
  1. W !
  1. Q
  1. HD1 ;
  1. W:$D(IOF) @IOF
  1. ; SD*5.3*645 - replaced 'Date Desired' with 'CID/PD' and adjusted format
  1. ;W !!,"Name",?30,"Date Entered",?45,"Date Desired",?60,"# of Days Waiting",!
  1. W !!,"Name",?30,"Date Entered",?47,"CID/PD",?60,"# of Days Waiting",!
  1. END K X1,X2,CT1,CT2,DATE,I,INS,OPEN,FORM
  1. K ^TMP("SDWLRPT1",$J) Q
  1. ;