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 Dec 13, 2024@03:03:22 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"
