source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLAHRC.m@ 1383

SDWLAHRC ;;IOFO BAY PINES/TEH - EWL REPORT - COMPILE;06/12/2002 ; 20 Aug 2002 2:10 PM
 ;;5.3;scheduling;**419**;AUG 13 1993;Build 16
 ;
 ;
 ;
 ;
 ;
 ;
 ;
 ;
 ;
 ;=====================================================================================
 ;                                         NOTES
 ;=====================================================================================
 ;
 ;
 ;
 ;
 ;
 Q
COM ;START OF COMPILE - GET FIRST SORT
 N %H,DA
 S (SDWL0,SDWL1,SDWL2,SDWL3,SDWL4)="" K SDWLST
 F  S SDWL0=$O(^XTMP("SDWLAHR",SDWLJOB,SDWL0)) Q:SDWL0<1  D
 .F  S SDWL1=$O(^XTMP("SDWLAHR",SDWLJOB,SDWL0,SDWL1)) Q:SDWL1=""  D
 ..S SDWLTY=""
 ..I SDWL1["DAT" S SDWLTY="DAT"
 ..I SDWL1["NUM" S SDWLTY="NUM"
 ..I SDWL1["FT" S SDWLTY="FT"
 ..I SDWL1["RS" S SDWLTY="RS"
 ..I SDWL1["PRT" S SDWLTY="PRT"
 ..I SDWL1["ANM" S SDWLTY="ANM"
 ..I SDWLTY="" S SDWLTY="ERR"
 ..F  S SDWL2=$O(^XTMP("SDWLAHR",SDWLJOB,SDWL0,SDWL1,SDWL2)) Q:SDWL2=""  D
 ...F  S SDWL3=$O(^XTMP("SDWLAHR",SDWLJOB,SDWL0,SDWL1,SDWL2,SDWL3)) Q:SDWL3=""  D
 ....S SDWLX=$G(^XTMP("SDWLAHR",SDWLJOB,SDWL0,SDWL1,SDWL2,SDWL3))
 ....I SDWLTY["FT" S SDWL4="" F  S SDWL4=$O(^XTMP("SDWLAHR",SDWLJOB,SDWL0,SDWL1,SDWL2,SDWL3,SDWL4)) Q:SDWL4=""  D
 .....S SDWLX=$G(^XTMP("SDWLAHR",SDWLJOB,SDWL0,SDWL1,SDWL2,SDWL3,SDWL4))
 ....S SDWLST(SDWL0,SDWL2,SDWLX,SDWL1)=""
 D CHK
 D PRT
 K PG,S,SDWL0,SDWL1,SDWL2,SDWL3,SDWL4,SDWLA,SDWLBDT,SDWLEDT,SDWLIEN,SDWLIENS,SDWLJOB,SDWLMN,SDWLMX,SDWLNM,SDWLOK
 K SDWLR,SDWLTY,X,Y
 Q
CHK ;GET SORT LOGICAL
 S SDWLIEN=0 F  S SDWLIEN=$O(^SDWL(409.3,SDWLIEN)) Q:SDWLIEN<1  D  D SET1
 .S (SDWL0,SDWL1,SDWL2,SDWL3)=""
 .F  S SDWL0=$O(SDWLST(SDWL0)) Q:SDWL0<1  D
 ..S SDWLOK(SDWL0)=0
 ..F  S SDWL1=$O(SDWLST(SDWL0,SDWL1)) Q:SDWL1=""  D
 ...F  S SDWL2=$O(SDWLST(SDWL0,SDWL1,SDWL2)) Q:SDWL2=""  D
 ....F  S SDWL3=$O(SDWLST(SDWL0,SDWL1,SDWL2,SDWL3)) Q:SDWL3=""  D
 .....S SDWLNM="ZZ",SDWLTY=$S(SDWL3["PRT":"PRT",SDWL3["DAT":"DAT",SDWL3["RS":"RS",SDWL3["FT":"FT",SDWL3["NUM":"NUM",SDWL3["ANM":"ANM",1:"") D CHK1
 Q
CHK1 ;CHECK EWL PATIENT FILE
 I $D(SDWLTY),SDWLTY="FT" D  Q
 .S SDWLIENS=SDWLIEN_",",X=$$GET1^DIQ(409.3,SDWLIENS,SDWL1,"I") D
 ..I X[SDWL2 S SDWLOK(SDWL0)=1
 I $D(SDWLTY),SDWLTY="NUM" D  Q
 .S SDWLNM=$P(SDWL2,U),SDWLMX=$P(SDWL2,U,2),SDWLIENS=SDWLIEN_",",X=$$GET1^DIQ(409.3,SDWLIENS,SDWL1,"I") D
 ..I X'<SDWLMN&(X'>SDWLMX) S SDWLOK(SDWL0)=1
 I $D(SDWLTY),SDWLTY="DAT" D  Q
 .S SDWLBDT=$P(SDWL2,U),SDWLEDT=$P(SDWL2,U,2),SDWLIENS=SDWLIEN_",",X=$$GET1^DIQ(409.3,SDWLIENS,SDWL1,"I") D
 ..I X'<SDWLBDT&(X'>SDWLEDT) S SDWLOK(SDWL0)=1
 I $D(SDWLTY),SDWLTY="RS" D  Q
 .S SDWLIENS=SDWLIEN_",",X=$$GET1^DIQ(409.3,SDWLIENS,SDWL1,"I") I SDWL2=X S SDWLOK(SDWL0)=1
 I $D(SDWLTY),SDWLTY="PRT" D  Q
 .S SDWLIENS=SDWLIEN_",",X=$$GET1^DIQ(409.3,SDWLIENS,SDWL1,"I") I SDWL2=X S SDWLOK(SDWL0)=1
 I $D(SDWLTY),SDWLTY="ANM" D  Q
 .S SDWLIENS=SDWLIEN_",",X=$$GET1^DIQ(409.3,SDWLIENS,SDWL1,"I"),SDWLNM=$$GET1^DIQ(2,X_",","NAME","I") S SDWLOK(SDWL0)=1
 Q
SET1 ;
 S SDWLR=0,SDWLOK=1 F  S SDWLR=$O(SDWLOK(SDWLR)) Q:SDWLR<1  D
 .S S=SDWLOK(SDWLR) I 'S S SDWLOK=0
 I SDWLOK S ^XTMP("SDWLAHR",SDWLJOB,"LIST",SDWLNM,SDWLIEN)="",SDWL4=SDWL4+1
 Q
PRT S PG=0 D HD
 S SDWLA=0,SDWLNM="" K SDWLSTOP
 F  S SDWLNM=$O(^XTMP("SDWLAHR",SDWLJOB,"LIST",SDWLNM)) G END:$$S^ZTLOAD Q:SDWLNM=""  D  I $D(SDWLSTOP),'SDWLSTOP G END
 .F  S SDWLA=$O(^XTMP("SDWLAHR",SDWLJOB,"LIST",SDWLNM,SDWLA)) G END:$$S^%ZTLOAD Q:SDWLA<1  D  I $D(SDWLSTOP),'SDWLSTOP G END
 ..S DIC="^SDWL(409.3,",DA=SDWLA,DR=":" D EN^DIQ
 ..I $Y>(IOSL-5) D:IOST["C-"
 ...S DIR(0)="Y",DIR("A")="Do You Wish to Continue",DIR("B")="YES" D ^DIR D  I Y D HD Q
 ...S SDWLSTOP=Y
 Q
HD W:$D(IOF) @IOF
 W !!,?80-$L("EWL CUSTOM AD HOC REPORT")\2,"EWL CUSTOM AD HOC REPORT",?65 S PG=PG+1 W "PAGE: ",PG,!
 S %H=+$H D YX^%DTC W ?80-$L(Y)\2,Y,!!
 Q
END ;
 K DIR,DIC,DR,DIE,SDWLERR,SDWLF,SDWLX,SDLFD,SDWLCTX,SDWLDAT,SDWLPROM,SDWLINST,SDWLI,SDWLTAG,SDWLY
 Q