- SDWLRQ2 ;;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT PRIM CARE TEAM AND POSITION ASSIGNMENTS;06/12/2002 ; 29 Aug 2002 2:53 PM
- ;;5.3;scheduling;**263,425,482**;AUG 13 1993
- ;
- ;
- ;******************************************************************
- ; CHANGE LOG
- ;
- ; DATE PATCH DESCRIPTION
- ; ---- ----- -----------
- ;
- ;
- ;
- ;
- EN ;Header
- N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
- N SDTEAM,SDHIST,SDACTIVE
- D HD
- 1 S SDWLINST="",SDWLERR=0,SDWLE=0 K ^TMP("SDWLRQ2",$J),DIC,DIR,DR,DIE
- D INS G END:SDWLERR
- 2 D CAT G 1:SDWLERR
- 3 D OPEN G 2:SDWLERR
- S ^TMP("SDWLRQ2",$J,"DATE")=""
- 4 I %=2 D DATE G 3:SDWLERR
- 6 D FORM G 4:SDWLERR,END:$D(DUOUT)
- 7 D DIS G EN:SDWLERR=1,END:SDWLERR=2
- D QUE
- Q
- INS ;Get Institution
- S SDWLPROM="Select Institution ALL // ",SDWLERR=0
- IN W ! S DIC(0)="QEMA",DIC("A")=SDWLPROM,DIC=4,DIC("S")="I $D(^SCTM(404.51,""AINST"",+Y))" D ^DIC I Y<0,'SDWLE D
- .S (SDWLINS,SDWLINST)="" F S SDWLINS=$O(^SCTM(404.51,"AINST",SDWLINS)) Q:SDWLINS="" S SDWLINST=SDWLINST_SDWLINS_";"
- I X="^" S SDWLERR=1 Q
- G IN2:Y<0,END:$D(DUOUT)
- I Y="All"!(Y="")!(Y="all")!(Y="ALL") S ^TMP("SDWLRQ2",$J,"INS")=SDWLINST G IN3
- S SDWLINST=SDWLINST_+Y_";",SDWLPROM="Another Institution: ",SDWLE=1 G IN
- IN2 S ^TMP("SDWLRQ2",$J,"INS")=SDWLINST
- IN3 Q
- DATE ;Date range selection
- S %=1 W !,"Print Report for ALL dates? " D YN^DICN
- I %=1 S ^TMP("SDWLRQ2",$J,"DATE")="ALL" G E1
- Q:%=0
- Q:%=-1
- S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start with Date Entered: " D ^%DT G E1:Y<1 S SDWLBDT=Y
- S %DT(0)=SDWLBDT,%DT("A")="End with Date Entered: " D ^%DT
- I X["^" S SDWLERR=1 Q
- G E1:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")
- I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE
- S ^TMP("SDWLRQ2",$J,"DATE")=SDWLBDT_"^"_SDWLEDT Q
- E1 Q
- CAT ;Report category selection
- W !!," *** Report Category Selection ***" S SDWLERR=0
- S SDWLERR=0,SDWLCAT="",DIR(0)="S0^1:Team;2:Position",DIR("L",1)=" 1. Team",DIR("L")=" 2. Position"
- D ^DIR
- I X="^" S SDWLERR=1 Q
- S X=$S(X["T":"T",X["t":"T",X["P":"P",X["p":"P",X=1:"T",X=2:"P",1:"")
- I X="" W *7," Invalid Selection." G CAT
- W !!,"Select Category for Report Output",!
- S SDWLX=$S(X="T":"Team: ALL/ ",X="P":"Position: ALL/ ")
- S SDWLF=$S(X="T":404.51,X="P":404.57)
- K DIR,DIC,DR
- S ^TMP("SDWLRQ2",$J,"CT1")=X_"^"_SDWLF
- S DIC("A")=SDWLX
- I SDWLF=404.51 D
- .S DIC("S")="I $$ACTIVE^SDWLRQ2(Y),SDWLINST[+$P($G(^SCTM(404.51,+Y,0)),""^"",7)"
- CT1 W ! S DIC(0)="QEMNZA",DIC=SDWLF D ^DIC
- I X="^" S SDWLERR=1 Q
- I Y<1,SDWLCAT="" S ^TMP("SDWLRQ2",$J,"CT2")="ALL" G CT3
- I Y<0,'$D(^TMP("SDWLRQ2",$J,"CT1")) W !,"This Entry is Required." G CAT
- G CT2:Y<0
- S SDWLCAT=SDWLCAT_Y_";",DIC("A")="Another "_$P(SDWLX,":",1)_": ",SDWLE=1 G CT1
- CT2 G CT1:'$D(SDWLCAT) S ^TMP("SDWLRQ2",$J,"CT2")=SDWLCAT
- CT3 Q
- OPEN ;OPEN Wait List Entries
- S %=1 W !!,"Do you want only 'OPEN' Wait List Entries " D YN^DICN
- I '% W *7,"Must Enter 'YES' or 'NO'." G OPEN
- I %=-1 S SDWLERR=1
- S ^TMP("SDWLRQ2",$J,"OPEN")=$S(%=1:"O",1:"C")
- Q
- FORM ;Report Format
- S SDWLERR=0,DIR(0)="SO^1:Detailed;2:Summary",DIR("L",2)=" 1. Detailed"
- S DIR("L")=" 2. Summary",DIR("L",1)="Select One of the Following: "
- D ^DIR
- I X="^" S DUOUT=1 Q
- S X=$S(X["S":"S",X["s":"S",X["D":"D",X["d":"D",X=1:"D",X=2:"S",1:"")
- I X="" W *7," Invalid Response" G FORM
- S ^TMP("SDWLRQ2",$J,"FORM")=X
- Q
- DIS ;Display Parameters
- S SDWLERR=0 W !!,?80-$L("*** Selected Report Parameters ***")\2,"*** Selected Report Parameters ***",!
- F SDWLI="INS","CT1","CT2","FORM","OPEN" D
- .S X="SDWL"_SDWLI,@X=$G(^TMP("SDWLRQ2",$J,SDWLI))
- F SDWLTAG="IS","CT","OP","PR" D @SDWLTAG
- Q
- IS I SDWLINS'["ALL" D
- .K SDWLY F I=1:1 S SDWLY=$P($P(SDWLINS,";",I),U,1) Q:SDWLY="" S SDWLY(I)=SDWLY
- .W !,?20,"Institution: "
- .I $D(SDWLY) S I="" F S I=$O(SDWLY(I)) Q:I="" W:I>1 !,?33 W $P($G(^DIC(4,SDWLY(I),0)),U,1)
- .K SDWLY
- I SDWLINS["ALL" W !,?20,"Institution: ALL "
- Q
- CT I SDWLCT2'["ALL" D
- .S SDWLF=$P(SDWLCT1,U,2)
- .K SDWLY F I=1:1 S SDWLY=$P($P(SDWLCT2,";",I),U,2) Q:SDWLY="" S SDWLY(I)=SDWLY
- .W !,?16,"Report Category: " W $S(SDWLCT1["T":"Team",1:"Position"),!,?36 I @X="ALL" W "All "
- .I $D(SDWLY) S I="" F S I=$O(SDWLY(I)) Q:I="" W:I>1 !,?35 W $$EXTERNAL^DILFD(SDWLF,.01,,SDWLY(I))
- I SDWLCT2["ALL" W !,?16,"Report Category: " W $S(SDWLCT1["T":"Team",1:"Position"),!,?36 W "ALL "
- Q
- OP W !,?18,"Output Format: ",$S(SDWLFORM="D":" Detailed",1:" Summary")
- Q
- PR I SDWLOPEN="O" W !,?25,"Printing 'OPEN' Entries Only."
- E W !,?25,"Printing ALL Entries."
- S %=1 W !!,"Are these Parameters Correct " D YN^DICN I %=2 S SDWLERR=1 W !," This Report will NOT be queued to print."
- I SDWLERR S DIR(0)="E" D ^DIR I X["^" S SDWLERR=2
- Q
- ACTIVE(Y) ;Active Team
- S SDTEAM="",SDHIST="",SDACTIVE=""
- I SDWLF="404.51" D
- .S SDHIST=$O(^SCTM(404.58,"B",+Y,SDHIST),-1)
- .S SDACTIVE=$P($G(^SCTM(404.58,+SDHIST,0)),"^",3)
- Q +SDACTIVE
- QUE ;Queue Report
- N ZTQUEUED,POP
- K %ZIS,IOP,IOC,ZTIO,SDWLSPT S %ZIS="MQ" D ^%ZIS G:POP QUE1
- S ZTRTN=$S(SDWLFORM="D":"EN^SDWLRPT2",1:"EN^SDWLRPS2"),ZTDTH=$H,ZTDESC="WAIT LIST REPORT FORMAT 2"
- S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLRQ2",$J,SDWLTASK)) Q:SDWLTASK="" D
- .S SDWLTK=$G(^TMP("SDWLRQ2",$J,SDWLTASK))
- .S ZTSAVE(SDWLTASK)=SDWLTK
- I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G END
- QUE1 S:$E(IOST,1,2)="C-" SDWLSPT=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLSPT
- ;
- END K SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
- K DIR,DIC,DR,DIE,SDWLSPT,I
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- HD W:$D(IOF) @IOF W !,?80-$L("Primary Care Team/Position Assignment Wait List Report")\2,"Primary Care Team/Position Assignment Wait List Report"
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLRQ2 5884 printed Jan 18, 2025@04:04:32 Page 2
- SDWLRQ2 ;;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT PRIM CARE TEAM AND POSITION ASSIGNMENTS;06/12/2002 ; 29 Aug 2002 2:53 PM
- +1 ;;5.3;scheduling;**263,425,482**;AUG 13 1993
- +2 ;
- +3 ;
- +4 ;******************************************************************
- +5 ; CHANGE LOG
- +6 ;
- +7 ; DATE PATCH DESCRIPTION
- +8 ; ---- ----- -----------
- +9 ;
- +10 ;
- +11 ;
- +12 ;
- EN ;Header
- +1 NEW ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
- +2 NEW SDTEAM,SDHIST,SDACTIVE
- +3 DO HD
- 1 SET SDWLINST=""
- SET SDWLERR=0
- SET SDWLE=0
- KILL ^TMP("SDWLRQ2",$JOB),DIC,DIR,DR,DIE
- +1 DO INS
- if SDWLERR
- GOTO END
- 2 DO CAT
- if SDWLERR
- GOTO 1
- 3 DO OPEN
- if SDWLERR
- GOTO 2
- +1 SET ^TMP("SDWLRQ2",$JOB,"DATE")=""
- 4 IF %=2
- DO DATE
- if SDWLERR
- GOTO 3
- 6 DO FORM
- if SDWLERR
- GOTO 4
- if $DATA(DUOUT)
- GOTO END
- 7 DO DIS
- if SDWLERR=1
- GOTO EN
- if SDWLERR=2
- GOTO END
- +1 DO QUE
- +2 QUIT
- INS ;Get Institution
- +1 SET SDWLPROM="Select Institution ALL // "
- SET SDWLERR=0
- IN WRITE !
- SET DIC(0)="QEMA"
- SET DIC("A")=SDWLPROM
- SET DIC=4
- SET DIC("S")="I $D(^SCTM(404.51,""AINST"",+Y))"
- DO ^DIC
- IF Y<0
- IF 'SDWLE
- Begin DoDot:1
- +1 SET (SDWLINS,SDWLINST)=""
- FOR
- SET SDWLINS=$ORDER(^SCTM(404.51,"AINST",SDWLINS))
- if SDWLINS=""
- QUIT
- SET SDWLINST=SDWLINST_SDWLINS_";"
- End DoDot:1
- +2 IF X="^"
- SET SDWLERR=1
- QUIT
- +3 if Y<0
- GOTO IN2
- if $DATA(DUOUT)
- GOTO END
- +4 IF Y="All"!(Y="")!(Y="all")!(Y="ALL")
- SET ^TMP("SDWLRQ2",$JOB,"INS")=SDWLINST
- GOTO IN3
- +5 SET SDWLINST=SDWLINST_+Y_";"
- SET SDWLPROM="Another Institution: "
- SET SDWLE=1
- GOTO IN
- IN2 SET ^TMP("SDWLRQ2",$JOB,"INS")=SDWLINST
- IN3 QUIT
- DATE ;Date range selection
- +1 SET %=1
- WRITE !,"Print Report for ALL dates? "
- DO YN^DICN
- +2 IF %=1
- SET ^TMP("SDWLRQ2",$JOB,"DATE")="ALL"
- GOTO E1
- +3 if %=0
- QUIT
- +4 if %=-1
- QUIT
- +5 SET SDWLERR=0
- WRITE !
- SET %DT="AE"
- SET %DT("A")="Start with Date Entered: "
- DO ^%DT
- if Y<1
- GOTO E1
- SET SDWLBDT=Y
- +6 SET %DT(0)=SDWLBDT
- SET %DT("A")="End with Date Entered: "
- DO ^%DT
- +7 IF X["^"
- SET SDWLERR=1
- QUIT
- +8 if Y<1
- GOTO E1
- SET SDWLEDT=Y
- KILL %DT(0),%DT("A")
- +9 IF SDWLEDT<SDWLBDT
- WRITE !,"Beginning Date must be greater than Ending Date."
- GOTO DATE
- +10 SET ^TMP("SDWLRQ2",$JOB,"DATE")=SDWLBDT_"^"_SDWLEDT
- QUIT
- E1 QUIT
- CAT ;Report category selection
- +1 WRITE !!," *** Report Category Selection ***"
- SET SDWLERR=0
- +2 SET SDWLERR=0
- SET SDWLCAT=""
- SET DIR(0)="S0^1:Team;2:Position"
- SET DIR("L",1)=" 1. Team"
- SET DIR("L")=" 2. Position"
- +3 DO ^DIR
- +4 IF X="^"
- SET SDWLERR=1
- QUIT
- +5 SET X=$SELECT(X["T":"T",X["t":"T",X["P":"P",X["p":"P",X=1:"T",X=2:"P",1:"")
- +6 IF X=""
- WRITE *7," Invalid Selection."
- GOTO CAT
- +7 WRITE !!,"Select Category for Report Output",!
- +8 SET SDWLX=$SELECT(X="T":"Team: ALL/ ",X="P":"Position: ALL/ ")
- +9 SET SDWLF=$SELECT(X="T":404.51,X="P":404.57)
- +10 KILL DIR,DIC,DR
- +11 SET ^TMP("SDWLRQ2",$JOB,"CT1")=X_"^"_SDWLF
- +12 SET DIC("A")=SDWLX
- +13 IF SDWLF=404.51
- Begin DoDot:1
- +14 SET DIC("S")="I $$ACTIVE^SDWLRQ2(Y),SDWLINST[+$P($G(^SCTM(404.51,+Y,0)),""^"",7)"
- End DoDot:1
- CT1 WRITE !
- SET DIC(0)="QEMNZA"
- SET DIC=SDWLF
- DO ^DIC
- +1 IF X="^"
- SET SDWLERR=1
- QUIT
- +2 IF Y<1
- IF SDWLCAT=""
- SET ^TMP("SDWLRQ2",$JOB,"CT2")="ALL"
- GOTO CT3
- +3 IF Y<0
- IF '$DATA(^TMP("SDWLRQ2",$JOB,"CT1"))
- WRITE !,"This Entry is Required."
- GOTO CAT
- +4 if Y<0
- GOTO CT2
- +5 SET SDWLCAT=SDWLCAT_Y_";"
- SET DIC("A")="Another "_$PIECE(SDWLX,":",1)_": "
- SET SDWLE=1
- GOTO CT1
- CT2 if '$DATA(SDWLCAT)
- GOTO CT1
- SET ^TMP("SDWLRQ2",$JOB,"CT2")=SDWLCAT
- CT3 QUIT
- OPEN ;OPEN Wait List Entries
- +1 SET %=1
- WRITE !!,"Do you want only 'OPEN' Wait List Entries "
- DO YN^DICN
- +2 IF '%
- WRITE *7,"Must Enter 'YES' or 'NO'."
- GOTO OPEN
- +3 IF %=-1
- SET SDWLERR=1
- +4 SET ^TMP("SDWLRQ2",$JOB,"OPEN")=$SELECT(%=1:"O",1:"C")
- +5 QUIT
- FORM ;Report Format
- +1 SET SDWLERR=0
- SET DIR(0)="SO^1:Detailed;2:Summary"
- SET DIR("L",2)=" 1. Detailed"
- +2 SET DIR("L")=" 2. Summary"
- SET DIR("L",1)="Select One of the Following: "
- +3 DO ^DIR
- +4 IF X="^"
- SET DUOUT=1
- QUIT
- +5 SET X=$SELECT(X["S":"S",X["s":"S",X["D":"D",X["d":"D",X=1:"D",X=2:"S",1:"")
- +6 IF X=""
- WRITE *7," Invalid Response"
- GOTO FORM
- +7 SET ^TMP("SDWLRQ2",$JOB,"FORM")=X
- +8 QUIT
- DIS ;Display Parameters
- +1 SET SDWLERR=0
- WRITE !!,?80-$LENGTH("*** Selected Report Parameters ***")\2,"*** Selected Report Parameters ***",!
- +2 FOR SDWLI="INS","CT1","CT2","FORM","OPEN"
- Begin DoDot:1
- +3 SET X="SDWL"_SDWLI
- SET @X=$GET(^TMP("SDWLRQ2",$JOB,SDWLI))
- End DoDot:1
- +4 FOR SDWLTAG="IS","CT","OP","PR"
- DO @SDWLTAG
- +5 QUIT
- IS IF SDWLINS'["ALL"
- Begin DoDot:1
- +1 KILL SDWLY
- FOR I=1:1
- SET SDWLY=$PIECE($PIECE(SDWLINS,";",I),U,1)
- if SDWLY=""
- QUIT
- SET SDWLY(I)=SDWLY
- +2 WRITE !,?20,"Institution: "
- +3 IF $DATA(SDWLY)
- SET I=""
- FOR
- SET I=$ORDER(SDWLY(I))
- if I=""
- QUIT
- if I>1
- WRITE !,?33
- WRITE $PIECE($GET(^DIC(4,SDWLY(I),0)),U,1)
- +4 KILL SDWLY
- End DoDot:1
- +5 IF SDWLINS["ALL"
- WRITE !,?20,"Institution: ALL "
- +6 QUIT
- CT IF SDWLCT2'["ALL"
- Begin DoDot:1
- +1 SET SDWLF=$PIECE(SDWLCT1,U,2)
- +2 KILL SDWLY
- FOR I=1:1
- SET SDWLY=$PIECE($PIECE(SDWLCT2,";",I),U,2)
- if SDWLY=""
- QUIT
- SET SDWLY(I)=SDWLY
- +3 WRITE !,?16,"Report Category: "
- WRITE $SELECT(SDWLCT1["T":"Team",1:"Position"),!,?36
- IF @X="ALL"
- WRITE "All "
- +4 IF $DATA(SDWLY)
- SET I=""
- FOR
- SET I=$ORDER(SDWLY(I))
- if I=""
- QUIT
- if I>1
- WRITE !,?35
- WRITE $$EXTERNAL^DILFD(SDWLF,.01,,SDWLY(I))
- End DoDot:1
- +5 IF SDWLCT2["ALL"
- WRITE !,?16,"Report Category: "
- WRITE $SELECT(SDWLCT1["T":"Team",1:"Position"),!,?36
- WRITE "ALL "
- +6 QUIT
- OP WRITE !,?18,"Output Format: ",$SELECT(SDWLFORM="D":" Detailed",1:" Summary")
- +1 QUIT
- PR IF SDWLOPEN="O"
- WRITE !,?25,"Printing 'OPEN' Entries Only."
- +1 IF '$TEST
- WRITE !,?25,"Printing ALL Entries."
- +2 SET %=1
- WRITE !!,"Are these Parameters Correct "
- DO YN^DICN
- IF %=2
- SET SDWLERR=1
- WRITE !," This Report will NOT be queued to print."
- +3 IF SDWLERR
- SET DIR(0)="E"
- DO ^DIR
- IF X["^"
- SET SDWLERR=2
- +4 QUIT
- ACTIVE(Y) ;Active Team
- +1 SET SDTEAM=""
- SET SDHIST=""
- SET SDACTIVE=""
- +2 IF SDWLF="404.51"
- Begin DoDot:1
- +3 SET SDHIST=$ORDER(^SCTM(404.58,"B",+Y,SDHIST),-1)
- +4 SET SDACTIVE=$PIECE($GET(^SCTM(404.58,+SDHIST,0)),"^",3)
- End DoDot:1
- +5 QUIT +SDACTIVE
- QUE ;Queue Report
- +1 NEW ZTQUEUED,POP
- +2 KILL %ZIS,IOP,IOC,ZTIO,SDWLSPT
- SET %ZIS="MQ"
- DO ^%ZIS
- if POP
- GOTO QUE1
- +3 SET ZTRTN=$SELECT(SDWLFORM="D":"EN^SDWLRPT2",1:"EN^SDWLRPS2")
- SET ZTDTH=$HOROLOG
- SET ZTDESC="WAIT LIST REPORT FORMAT 2"
- +4 SET SDWLTASK=""
- FOR
- SET SDWLTASK=$ORDER(^TMP("SDWLRQ2",$JOB,SDWLTASK))
- if SDWLTASK=""
- QUIT
- Begin DoDot:1
- +5 SET SDWLTK=$GET(^TMP("SDWLRQ2",$JOB,SDWLTASK))
- +6 SET ZTSAVE(SDWLTASK)=SDWLTK
- End DoDot:1
- +7 IF $DATA(IO("Q"))
- KILL IO("Q")
- DO ^%ZTLOAD
- WRITE !,"REQUEST QUEUED"
- GOTO END
- QUE1 if $EXTRACT(IOST,1,2)="C-"
- SET SDWLSPT=1
- IF $DATA(ZTRTN)
- USE IO
- DO @ZTRTN
- KILL SDWLSPT
- +1 ;
- END KILL SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
- +1 KILL DIR,DIC,DR,DIE,SDWLSPT,I
- +2 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 QUIT
- HD if $DATA(IOF)
- WRITE @IOF
- WRITE !,?80-$LENGTH("Primary Care Team/Position Assignment Wait List Report")\2,"Primary Care Team/Position Assignment Wait List Report"