| 1 | SDWLCU1 ;IOFO BAY PINES/DMR - EWL FILE 409.3 CLEANUP ;2/4/03
|
|---|
| 2 | ;;5.3;scheduling;**280,427**;AUG 13 1993
|
|---|
| 3 | INIT ;
|
|---|
| 4 | S (IEN,REC,NUM,COUNT,TOTAL,WLTC1,WLTC2,WLTC3,WLTC4,INST,CODE,NAME,ANS)=""
|
|---|
| 5 | S (INST1,INST2,INST3,INST4,POS,POSNAM,TEAM,TEAMN,CLINIC,CLINICN,CLNAM,SER,SERN,SERNAM)=""
|
|---|
| 6 | K ^TMP($J,"SDWLCU1"),^TMP($J,"EWL"),SDWLERR
|
|---|
| 7 | D START
|
|---|
| 8 | D DISPLAY
|
|---|
| 9 | D ^SDWLCU5
|
|---|
| 10 | D NULL
|
|---|
| 11 | W !!," ***** EWL CLEANUP RUN HAS FINISHED *****"
|
|---|
| 12 | W !!,"==>> Run option until list is clean.",!
|
|---|
| 13 | D EXIT
|
|---|
| 14 | Q
|
|---|
| 15 | START ;
|
|---|
| 16 | F S INST=$O(^SDWL(409.3,"C",INST)) Q:INST<1 D
|
|---|
| 17 | .S CODE=$$GET1^DIQ(4,INST_",",11,"I") D
|
|---|
| 18 | ..S IEN="" F S IEN=$O(^SDWL(409.3,"C",INST,IEN)) Q:IEN<1 D
|
|---|
| 19 | ...S INCK="" S INCK=$$TF^XUAF4(INST)
|
|---|
| 20 | ...IF CODE'="N"!('INCK) D SAVE
|
|---|
| 21 | Q
|
|---|
| 22 | SAVE ;
|
|---|
| 23 | S ^TMP($J,"EWL",$J,IEN)=^SDWL(409.3,IEN,0)
|
|---|
| 24 | IF +$P($G(^SDWL(409.3,IEN,0)),"^",5)=1 S WLTC1=WLTC1+1 D
|
|---|
| 25 | .S TEAM=+$P($G(^SDWL(409.3,IEN,0)),"^",6),TEAMN=$P(^SCTM(404.51,TEAM,0),"^",1),^TMP($J,"SDWLCU1",1,INST,TEAM,TEAMN,IEN)=""
|
|---|
| 26 | IF +$P($G(^SDWL(409.3,IEN,0)),"^",5)=2 S WLTC2=WLTC2+1 D
|
|---|
| 27 | .S POS=+$P($G(^SDWL(409.3,IEN,0)),"^",7),POSNAM=$P(^SCTM(404.57,POS,0),"^",1),^TMP($J,"SDWLCU1",2,INST,POS,POSNAM,IEN)=""
|
|---|
| 28 | IF +$P($G(^SDWL(409.3,IEN,0)),"^",5)=3 S WLTC3=WLTC3+1 D
|
|---|
| 29 | .S SER=+$P($G(^SDWL(409.3,IEN,0)),"^",8),SERN=+$P(^SDWL(409.31,SER,0),"^",1),SERNAM=$$GET1^DIQ(40.7,SERN_",",.01),^TMP($J,"SDWLCU1",3,INST,SER,IEN)=""
|
|---|
| 30 | IF +$P($G(^SDWL(409.3,IEN,0)),"^",5)=4 S WLTC4=WLTC4+1 D
|
|---|
| 31 | .S CLINIC=+$P($G(^SDWL(409.3,IEN,0)),"^",9),CLINICN=+$P(^SDWL(409.32,CLINIC,0),"^",1),CLNAM=$$GET1^DIQ(44,CLINICN_",",.01),^TMP($J,"SDWLCU1",4,INST,CLINIC,IEN)=""
|
|---|
| 32 | Q
|
|---|
| 33 | DISPLAY ;
|
|---|
| 34 | S (CC,COUNT)="" F S CC=$O(^TMP($J,"EWL",$J,CC)) Q:CC="" S COUNT=COUNT+1
|
|---|
| 35 | Q:COUNT<1
|
|---|
| 36 | W #
|
|---|
| 37 | W !,COUNT,?10,"ENTRIES IN SD WAIT LIST POINT TO AN INSTITUTION WITH"
|
|---|
| 38 | W !,?10,"A STATUS NOT EQUAL TO NATIONAL OR ISN'T A TREATING FACILITY."
|
|---|
| 39 | IF WLTC1>.5 S (COUNT1,INST)="" D
|
|---|
| 40 | .F S INST=$O(^TMP($J,"SDWLCU1",1,INST)) Q:INST<1 D
|
|---|
| 41 | ..S IEN="" F S IEN=$O(^TMP($J,"SDWLCU1",1,INST,IEN)) Q:IEN="" S COUNT1=COUNT1+1
|
|---|
| 42 | .W !!,WLTC1,?10,"ENTRIES POINT TO FILE TEAM (404.51) AND "
|
|---|
| 43 | .W !,COUNT1,?10,"INSTITUTION(S) MUST BE CORRECTED."
|
|---|
| 44 | IF WLTC2>.5 S (COUNT1,INST)="" D
|
|---|
| 45 | .F S INST=$O(^TMP($J,"SDWLCU1",2,INST)) Q:INST<1 D
|
|---|
| 46 | ..S IEN="" F S IEN=$O(^TMP($J,"SDWLCU1",2,INST,IEN)) Q:IEN="" S COUNT1=COUNT1+1
|
|---|
| 47 | .W !!,WLTC2,?10,"ENTRIES POINT TO FILE TEAM POSITION (404.57) AND "
|
|---|
| 48 | .W !,COUNT1,?10,"INSTITUTION(S) MUST BE CORRECTED."
|
|---|
| 49 | IF WLTC3>.5 S (COUNT1,INST)="" D
|
|---|
| 50 | .F S INST=$O(^TMP($J,"SDWLCU1",3,INST)) Q:INST<1 D
|
|---|
| 51 | ..S IEN="" F S IEN=$O(^TMP($J,"SDWLCU1",3,INST,IEN)) Q:IEN="" S COUNT1=COUNT1+1
|
|---|
| 52 | .W !!,WLTC3,?10,"ENTRIES POINT TO FILE SD WL SERVICE/SPECIALTY (409.31) AND"
|
|---|
| 53 | .W !,COUNT1,?10,"INSTITUTION(S) MUST BE CORRECTED."
|
|---|
| 54 | IF WLTC4>.5 S (COUNT1,INST)="" D
|
|---|
| 55 | .F S INST=$O(^TMP($J,"SDWLCU1",4,INST)) Q:INST<1 D
|
|---|
| 56 | ..S IEN="" F S IEN=$O(^TMP($J,"SDWLCU1",4,INST,IEN)) Q:IEN="" S COUNT1=COUNT1+1
|
|---|
| 57 | .W !!,WLTC4,?10,"ENTRIES POINT TO FILE SD WL CLINIC LOCATION (409.32) AND"
|
|---|
| 58 | .W !,COUNT1,?10,"INSTITUTION(S) MUST BE CORRECTED."
|
|---|
| 59 | EDIT ;
|
|---|
| 60 | I WLTC1="",WLTC2="",WLTC3="",WLTC4="" Q
|
|---|
| 61 | S X=""
|
|---|
| 62 | I WLTC1 S X="1:PCMM TEAM ASSIGNMENT;"
|
|---|
| 63 | I WLTC2 S X=X_"2:PCMM POSITION ASSIGNMENT;"
|
|---|
| 64 | I WLTC3 S X=X_"3:SERVICE/SPECIALTY;"
|
|---|
| 65 | I WLTC4 S X=X_"4:SPECIFIC CLINIC"
|
|---|
| 66 | S DIR(0)="SO^"_X
|
|---|
| 67 | S DIR("L",1)=" Select Wait List Type: (or Enter '^' to EXIT)"
|
|---|
| 68 | S DIR("L",2)=""
|
|---|
| 69 | S:WLTC1 DIR("L",3)=" 1. PCMM TEAM ASSIGNMENT"
|
|---|
| 70 | S:WLTC2 DIR("L",4)=" 2. PCMM POSITION ASSIGNMENT"
|
|---|
| 71 | S:WLTC3 DIR("L",5)=" 3. SERVICE/SPECIALTY"
|
|---|
| 72 | S:WLTC4 DIR("L",6)=" 4. SPECIFIC CLINIC"
|
|---|
| 73 | S DIR("A")="Select Wait List Type: (or Enter '^' to EXIT)"
|
|---|
| 74 | D ^DIR G EXIT:$D(DUOUT),EDIT:Y=""
|
|---|
| 75 | I Y=4!(Y=3) S SDWLTY=+Y,SDWLR=SDWLTY_"^SDWLCU3" D @SDWLR G DISPLAY
|
|---|
| 76 | I Y=1!(Y=2) S SDWLTY=+Y,SDWLR=SDWLTY_"^SDWLCU2" D @SDWLR G DISPLAY
|
|---|
| 77 | NULL ;
|
|---|
| 78 | W !!,"** CHECK KEY FIELDS FOR NULL VALUE **",!!
|
|---|
| 79 | QUE ;Queue Report
|
|---|
| 80 | N ZTQUEUED,POP
|
|---|
| 81 | K %ZIS,IOP,IOC,ZTIO,SDWLSPT S %ZIS="MQ" D ^%ZIS G:POP QUE1
|
|---|
| 82 | S ZTRTN="^SDWLCU6",ZTDTH=$H,ZTDESC="WAIT LIST KEY FIELD-NULL REPORT"
|
|---|
| 83 | ;S SDWLTASK="" F S SDWLTASK=$O(^TMP("SDWLQOF",$J,SDWLTASK)) Q:SDWLTASK="" D
|
|---|
| 84 | ;.S SDWLTK=$G(^TMP("SDWLQOF",$J,SDWLTASK))
|
|---|
| 85 | ;.S ZTSAVE(SDWLTASK)=SDWLTK
|
|---|
| 86 | I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W !,"REQUEST QUEUED" G QEND
|
|---|
| 87 | QUE1 I $D(ZTRTN) U IO D @ZTRTN
|
|---|
| 88 | ;
|
|---|
| 89 | QEND ;
|
|---|
| 90 | K DIR,DIC,DR,DIE,ZTDTH,ZTDESC,ZTRTN
|
|---|
| 91 | D ^%ZISC
|
|---|
| 92 | Q
|
|---|
| 93 | EXIT ;
|
|---|
| 94 | K ^TMP($J,"SDWLCU1"),^TMP($J,"EWL")
|
|---|
| 95 | K IEN,REC,NUM,NN,COUNT,CC,TOTAL,WLTC1,WLTC2,WLTC3,WLTC4,INST,CODE,NAME,ANS,HEAD,INCK
|
|---|
| 96 | K INST1,INST2,INST3,INST4,POS,POSNAM,TEAM,TEAMN,CLINIC,CLINICN,CLNAM,SER,SERN,SERNAM
|
|---|
| 97 | K TEAM,TEAMN,INST,SSN,SDWLERR
|
|---|
| 98 | K C,COUNT1,CS,ENTRY,PAT,SDREC,SDWLDA,SDWLI,SDWLIENS,SDWLIN,SDWLINS
|
|---|
| 99 | K SDWLINSN,SDWLINST,SDWLIX,SDWLIZ,SDWLPO,SDWLR,SDWLSC,SDWLSCX,SDWLSS
|
|---|
| 100 | K SDWLSSN,SDWLSSX,SDWLTM,SDWLTY,TAG,SDWLSSV,ZCC
|
|---|
| 101 | Q
|
|---|
