| [623] | 1 | SDWLCU6 ;IOFO BAY PINES/DMR - EWL FILE 409.3 CLEANUP - print ;2/15/05
|
|---|
| 2 | ;;5.3;scheduling;**427**;AUG 13 1993
|
|---|
| 3 | N XFL,XFL1,XFLG,XDATA,END,SDWLAPTD,I,J,SDWLPD,SDWLPG,SDWLWD,SDWLTP,SDWLTP1
|
|---|
| 4 | S (IEN,PAT)="",(CC,SDWLPG,SDWLTP)=0,U="^",END=""
|
|---|
| 5 | D NOW^%DTC S Y=% D DD^%DT S SDWLDTP=Y
|
|---|
| 6 | D HD
|
|---|
| 7 | F S PAT=$O(^SDWL(409.3,"B",PAT)) Q:PAT="" D Q:END
|
|---|
| 8 | .S IEN="" F S IEN=$O(^SDWL(409.3,"B",PAT,IEN)) Q:IEN="" D Q:END
|
|---|
| 9 | ..S SDWLX=$G(^SDWL(409.3,IEN,0)),XFLG="",XFL=1,SDWLWD="",SDWLTP1=""
|
|---|
| 10 | ..F I=3,5,XFL S XDATA=$P(SDWLX,U,I) S:I=5&XDATA XFL=XDATA+5 S:'XDATA XFLG=XFLG_I I I=5,XFL=1 D FIX
|
|---|
| 11 | ..I XFLG D
|
|---|
| 12 | ...D HD:$Y+5>IOSL Q:END
|
|---|
| 13 | ...S NN="",NAME="" S NN=$P($G(^SDWL(409.3,IEN,0)),"^",1),NAME=$$GET1^DIQ(2,NN_",",.01,"E")
|
|---|
| 14 | ...S SDWLAPTD=$P(SDWLX,U,16) I SDWLAPTD'="" S Y=SDWLAPTD D DD^%DT S SDWLAPTD=Y
|
|---|
| 15 | ...W !!,IEN,?6,NAME,?40,SDWLAPTD,?54,$P(SDWLX,U,17),?58
|
|---|
| 16 | ...S XFL="" F I=1:1:3 Q:$E(XFLG,I)="" S XFL=XFL_$S(XFL'="":",",1:"")_$P("::INST::Type:Team:Postn:Srv/Spec:Clinic",":",$E(XFLG,I))
|
|---|
| 17 | ...W XFL W:SDWLTP1'="" "/++"
|
|---|
| 18 | ...W:SDWLWD'="" !,?5,SDWLWD
|
|---|
| 19 | ...S CC=CC+1
|
|---|
| 20 | Q:END
|
|---|
| 21 | IF CC>.5 W !!,"TOTAL null field error EWL entries: "_CC
|
|---|
| 22 | I SDWLTP>.5 W !!,"++ Missing Wait List Type and corresponding field entry (TEAM,POSITION,",!," SERVICE/SPECIALTY,CLINIC). Correct corresponding field entries",!," and running report again will correct Wait List Type field"
|
|---|
| 23 | D CLINIC
|
|---|
| 24 | W !!,"** End of Report **"
|
|---|
| 25 | Q
|
|---|
| 26 | CLINIC ;Display all clinics in file 409.32 that need to be cleaned up in file 44 in mail message
|
|---|
| 27 | S INST="",CLINIC=0,CC=0
|
|---|
| 28 | F S CLINIC=$O(^SDWL(409.32,CLINIC)) Q:'CLINIC D
|
|---|
| 29 | . S INST=$$GET1^DIQ(44,+$G(^SDWL(409.32,CLINIC,0))_",",3,"I")
|
|---|
| 30 | . I $$GET1^DIQ(4,INST_",",11,"I")'="N"!('$$TF^XUAF4(INST)) D
|
|---|
| 31 | .. S CC=CC+1
|
|---|
| 32 | .. I CC=1 W !!!,"The following clinics need to have the institution cleaned in file 44:",!!
|
|---|
| 33 | .. W !,?20,$$GET1^DIQ(44,+$G(^SDWL(409.32,CLINIC,0))_",",.01)
|
|---|
| 34 | Q
|
|---|
| 35 | FIX ;fix corrupted Wait List Type piece 5
|
|---|
| 36 | S XFL1=0,SDWLTP1=""
|
|---|
| 37 | F J=6:1:9 S XDATA=$P(SDWLX,U,J) S:XDATA'="" XFL1=J
|
|---|
| 38 | I 'XFL1 S SDWLTP=SDWLTP+1,SDWLTP1="++" Q
|
|---|
| 39 | I XFL'=1,XFL=XFL1 Q
|
|---|
| 40 | S $P(SDWLX,U,5)=XFL1-5,XFL=XFL1,^SDWL(409.3,IEN,0)=SDWLX
|
|---|
| 41 | S SDWLWD="** WAIT LIST TYPE corrected to value: "_(XFL1-5)_" ("_$P("TEAM;POSITION;SERV/SPCLTY;CLINIC",";",XFL1-5)_")"
|
|---|
| 42 | Q
|
|---|
| 43 | HD ;HDR
|
|---|
| 44 | I SDWLPG>0,$E(IOST,1,2)="C-" S END=$$EOP^ESPUTIL() Q:END
|
|---|
| 45 | S SDWLPG=SDWLPG+1 W:SDWLPG'=1 @IOF
|
|---|
| 46 | W !,?15,"Wait List Key Field 'NULL' Report"
|
|---|
| 47 | S Y=DT D DD^%DT S SDWLPD=Y W ?57,SDWLPD,?72,"Page: ",SDWLPG
|
|---|
| 48 | W !!,"STATION: "_DUZ(2)
|
|---|
| 49 | W !!,"IEN Patient Name",?42,"Wait Date",?53,"STS",?58,"Null Fields"
|
|---|
| 50 | Q
|
|---|
