| 1 | SDWLRQ2 ;;IOFO BAY PINES/TEH - ADHOC WAIT LIST REPORT PRIM CARE TEAM AND POSITION ASSIGNMENTS;06/12/2002 ; 29 Aug 2002 2:53 PM
|
|---|
| 2 | ;;5.3;scheduling;**263,425,482**;AUG 13 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;******************************************************************
|
|---|
| 6 | ; CHANGE LOG
|
|---|
| 7 | ;
|
|---|
| 8 | ; DATE PATCH DESCRIPTION
|
|---|
| 9 | ; ---- ----- -----------
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | ;
|
|---|
| 13 | ;
|
|---|
| 14 | EN ;Header
|
|---|
| 15 | N ZCODE,ZTDESC,ZTDTH,ZTIO,ZTQUEDED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 16 | N SDTEAM,SDHIST,SDACTIVE
|
|---|
| 17 | D HD
|
|---|
| 18 | 1 S SDWLINST="",SDWLERR=0,SDWLE=0 K ^TMP("SDWLRQ2",$J),DIC,DIR,DR,DIE
|
|---|
| 19 | D INS G END:SDWLERR
|
|---|
| 20 | 2 D CAT G 1:SDWLERR
|
|---|
| 21 | 3 D OPEN G 2:SDWLERR
|
|---|
| 22 | S ^TMP("SDWLRQ2",$J,"DATE")=""
|
|---|
| 23 | 4 I %=2 D DATE G 3:SDWLERR
|
|---|
| 24 | 6 D FORM G 4:SDWLERR,END:$D(DUOUT)
|
|---|
| 25 | 7 D DIS G EN:SDWLERR=1,END:SDWLERR=2
|
|---|
| 26 | D QUE
|
|---|
| 27 | Q
|
|---|
| 28 | INS ;Get Institution
|
|---|
| 29 | S SDWLPROM="Select Institution ALL // ",SDWLERR=0
|
|---|
| 30 | 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
|
|---|
| 31 | .S (SDWLINS,SDWLINST)="" F S SDWLINS=$O(^SCTM(404.51,"AINST",SDWLINS)) Q:SDWLINS="" S SDWLINST=SDWLINST_SDWLINS_";"
|
|---|
| 32 | I X="^" S SDWLERR=1 Q
|
|---|
| 33 | G IN2:Y<0,END:$D(DUOUT)
|
|---|
| 34 | I Y="All"!(Y="")!(Y="all")!(Y="ALL") S ^TMP("SDWLRQ2",$J,"INS")=SDWLINST G IN3
|
|---|
| 35 | S SDWLINST=SDWLINST_+Y_";",SDWLPROM="Another Institution: ",SDWLE=1 G IN
|
|---|
| 36 | IN2 S ^TMP("SDWLRQ2",$J,"INS")=SDWLINST
|
|---|
| 37 | IN3 Q
|
|---|
| 38 | DATE ;Date range selection
|
|---|
| 39 | S %=1 W !,"Print Report for ALL dates? " D YN^DICN
|
|---|
| 40 | I %=1 S ^TMP("SDWLRQ2",$J,"DATE")="ALL" G E1
|
|---|
| 41 | Q:%=0
|
|---|
| 42 | Q:%=-1
|
|---|
| 43 | S SDWLERR=0 W ! S %DT="AE",%DT("A")="Start with Date Entered: " D ^%DT G E1:Y<1 S SDWLBDT=Y
|
|---|
| 44 | S %DT(0)=SDWLBDT,%DT("A")="End with Date Entered: " D ^%DT
|
|---|
| 45 | I X["^" S SDWLERR=1 Q
|
|---|
| 46 | G E1:Y<1 S SDWLEDT=Y K %DT(0),%DT("A")
|
|---|
| 47 | I SDWLEDT<SDWLBDT W !,"Beginning Date must be greater than Ending Date." G DATE
|
|---|
| 48 | S ^TMP("SDWLRQ2",$J,"DATE")=SDWLBDT_"^"_SDWLEDT Q
|
|---|
| 49 | E1 Q
|
|---|
| 50 | CAT ;Report category selection
|
|---|
| 51 | W !!," *** Report Category Selection ***" S SDWLERR=0
|
|---|
| 52 | S SDWLERR=0,SDWLCAT="",DIR(0)="S0^1:Team;2:Position",DIR("L",1)=" 1. Team",DIR("L")=" 2. Position"
|
|---|
| 53 | D ^DIR
|
|---|
| 54 | I X="^" S SDWLERR=1 Q
|
|---|
| 55 | S X=$S(X["T":"T",X["t":"T",X["P":"P",X["p":"P",X=1:"T",X=2:"P",1:"")
|
|---|
| 56 | I X="" W *7," Invalid Selection." G CAT
|
|---|
| 57 | W !!,"Select Category for Report Output",!
|
|---|
| 58 | S SDWLX=$S(X="T":"Team: ALL/ ",X="P":"Position: ALL/ ")
|
|---|
| 59 | S SDWLF=$S(X="T":404.51,X="P":404.57)
|
|---|
| 60 | K DIR,DIC,DR
|
|---|
| 61 | S ^TMP("SDWLRQ2",$J,"CT1")=X_"^"_SDWLF
|
|---|
| 62 | S DIC("A")=SDWLX
|
|---|
| 63 | I SDWLF=404.51 D
|
|---|
| 64 | .S DIC("S")="I $$ACTIVE^SDWLRQ2(Y),SDWLINST[+$P($G(^SCTM(404.51,+Y,0)),""^"",7)"
|
|---|
| 65 | CT1 W ! S DIC(0)="QEMNZA",DIC=SDWLF D ^DIC
|
|---|
| 66 | I X="^" S SDWLERR=1 Q
|
|---|
| 67 | I Y<1,SDWLCAT="" S ^TMP("SDWLRQ2",$J,"CT2")="ALL" G CT3
|
|---|
| 68 | I Y<0,'$D(^TMP("SDWLRQ2",$J,"CT1")) W !,"This Entry is Required." G CAT
|
|---|
| 69 | G CT2:Y<0
|
|---|
| 70 | S SDWLCAT=SDWLCAT_Y_";",DIC("A")="Another "_$P(SDWLX,":",1)_": ",SDWLE=1 G CT1
|
|---|
| 71 | CT2 G CT1:'$D(SDWLCAT) S ^TMP("SDWLRQ2",$J,"CT2")=SDWLCAT
|
|---|
| 72 | CT3 Q
|
|---|
| 73 | OPEN ;OPEN Wait List Entries
|
|---|
| 74 | S %=1 W !!,"Do you want only 'OPEN' Wait List Entries " D YN^DICN
|
|---|
| 75 | I '% W *7,"Must Enter 'YES' or 'NO'." G OPEN
|
|---|
| 76 | I %=-1 S SDWLERR=1
|
|---|
| 77 | S ^TMP("SDWLRQ2",$J,"OPEN")=$S(%=1:"O",1:"C")
|
|---|
| 78 | Q
|
|---|
| 79 | FORM ;Report Format
|
|---|
| 80 | S SDWLERR=0,DIR(0)="SO^1:Detailed;2:Summary",DIR("L",2)=" 1. Detailed"
|
|---|
| 81 | S DIR("L")=" 2. Summary",DIR("L",1)="Select One of the Following: "
|
|---|
| 82 | D ^DIR
|
|---|
| 83 | I X="^" S DUOUT=1 Q
|
|---|
| 84 | S X=$S(X["S":"S",X["s":"S",X["D":"D",X["d":"D",X=1:"D",X=2:"S",1:"")
|
|---|
| 85 | I X="" W *7," Invalid Response" G FORM
|
|---|
| 86 | S ^TMP("SDWLRQ2",$J,"FORM")=X
|
|---|
| 87 | Q
|
|---|
| 88 | DIS ;Display Parameters
|
|---|
| 89 | S SDWLERR=0 W !!,?80-$L("*** Selected Report Parameters ***")\2,"*** Selected Report Parameters ***",!
|
|---|
| 90 | F SDWLI="INS","CT1","CT2","FORM","OPEN" D
|
|---|
| 91 | .S X="SDWL"_SDWLI,@X=$G(^TMP("SDWLRQ2",$J,SDWLI))
|
|---|
| 92 | F SDWLTAG="IS","CT","OP","PR" D @SDWLTAG
|
|---|
| 93 | Q
|
|---|
| 94 | IS I SDWLINS'["ALL" D
|
|---|
| 95 | .K SDWLY F I=1:1 S SDWLY=$P($P(SDWLINS,";",I),U,1) Q:SDWLY="" S SDWLY(I)=SDWLY
|
|---|
| 96 | .W !,?20,"Institution: "
|
|---|
| 97 | .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)
|
|---|
| 98 | .K SDWLY
|
|---|
| 99 | I SDWLINS["ALL" W !,?20,"Institution: ALL "
|
|---|
| 100 | Q
|
|---|
| 101 | CT I SDWLCT2'["ALL" D
|
|---|
| 102 | .S SDWLF=$P(SDWLCT1,U,2)
|
|---|
| 103 | .K SDWLY F I=1:1 S SDWLY=$P($P(SDWLCT2,";",I),U,2) Q:SDWLY="" S SDWLY(I)=SDWLY
|
|---|
| 104 | .W !,?16,"Report Category: " W $S(SDWLCT1["T":"Team",1:"Position"),!,?36 I @X="ALL" W "All "
|
|---|
| 105 | .I $D(SDWLY) S I="" F S I=$O(SDWLY(I)) Q:I="" W:I>1 !,?35 W $$EXTERNAL^DILFD(SDWLF,.01,,SDWLY(I))
|
|---|
| 106 | I SDWLCT2["ALL" W !,?16,"Report Category: " W $S(SDWLCT1["T":"Team",1:"Position"),!,?36 W "ALL "
|
|---|
| 107 | Q
|
|---|
| 108 | OP W !,?18,"Output Format: ",$S(SDWLFORM="D":" Detailed",1:" Summary")
|
|---|
| 109 | Q
|
|---|
| 110 | PR I SDWLOPEN="O" W !,?25,"Printing 'OPEN' Entries Only."
|
|---|
| 111 | E W !,?25,"Printing ALL Entries."
|
|---|
| 112 | S %=1 W !!,"Are these Parameters Correct " D YN^DICN I %=2 S SDWLERR=1 W !," This Report will NOT be queued to print."
|
|---|
| 113 | I SDWLERR S DIR(0)="E" D ^DIR I X["^" S SDWLERR=2
|
|---|
| 114 | Q
|
|---|
| 115 | ACTIVE(Y) ;Active Team
|
|---|
| 116 | S SDTEAM="",SDHIST="",SDACTIVE=""
|
|---|
| 117 | I SDWLF="404.51" D
|
|---|
| 118 | .S SDHIST=$O(^SCTM(404.58,"B",+Y,SDHIST),-1)
|
|---|
| 119 | .S SDACTIVE=$P($G(^SCTM(404.58,+SDHIST,0)),"^",3)
|
|---|
| 120 | Q +SDACTIVE
|
|---|
| 121 | QUE ;Queue Report
|
|---|
| 122 | N ZTQUEUED,POP
|
|---|
| 123 | K %ZIS,IOP,IOC,ZTIO,SDWLSPT S %ZIS="MQ" D ^%ZIS G:POP QUE1
|
|---|
| 124 | S ZTRTN=$S(SDWLFORM="D":"EN^SDWLRPT2",1:"EN^SDWLRPS2"),ZTDTH=$H,ZTDESC="WAIT LIST REPORT FORMAT 2"
|
|---|
| 125 | S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLRQ2",$J,SDWLTASK)) Q:SDWLTASK="" D
|
|---|
| 126 | .S SDWLTK=$G(^TMP("SDWLRQ2",$J,SDWLTASK))
|
|---|
| 127 | .S ZTSAVE(SDWLTASK)=SDWLTK
|
|---|
| 128 | I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G END
|
|---|
| 129 | QUE1 S:$E(IOST,1,2)="C-" SDWLSPT=1 I $D(ZTRTN) U IO D @ZTRTN K SDWLSPT
|
|---|
| 130 | ;
|
|---|
| 131 | END K SDWLTASK,SDWLY,SDWLED,WDWLBD,SDWLOPEN,SDWLDATE,SDWLFORM,SDWLPRI
|
|---|
| 132 | K DIR,DIC,DR,DIE,SDWLSPT,I
|
|---|
| 133 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 134 | Q
|
|---|
| 135 | 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"
|
|---|
