| 1 | DVBHDBA1 ;pke/isc-albany - Check, add to file 31; 25 AUG 88@12:00 | 
|---|
| 2 | ;;V4.0;HINQ;;03/25/92 | 
|---|
| 3 | EN K DO,DD S U="^" D DT^DICRW | 
|---|
| 4 | ; | 
|---|
| 5 | W !!?5,"*** Updating 'Disability Condition' file #31 ***",!! | 
|---|
| 6 | ; | 
|---|
| 7 | ENT S DIF="^TMP($J,",XCNP=0 K ^TMP($J) | 
|---|
| 8 | F ROU="DVBHDBA2","DVBHDBA3","DVBHDBA4","DVBHDBA5","DVBHDBA6","DVBHDBA7","DVBHDBA8","DVBHDBA9","DVBHDBAA","DVBHDBAB" S X=ROU X ^%ZOSF("LOAD") W ".." | 
|---|
| 9 | K DIF,XCNP,ROU | 
|---|
| 10 | ; | 
|---|
| 11 | S XMSUB="Disability Condition file #31 Changes",XMDUN="HINQ update" | 
|---|
| 12 | I $D(DUZ)#2,DUZ S XMDUZ=DUZ | 
|---|
| 13 | E  S XMDUZ=.5 | 
|---|
| 14 | S XMY(XMDUZ)="" | 
|---|
| 15 | D GET^XMA2 | 
|---|
| 16 | ; | 
|---|
| 17 | ADD S (LCNT,ACNT,CCNT)=0,$P(BL," ",40)="" W !! | 
|---|
| 18 | S (DIE,DIC)="^DIC(31,",DIC(0)="L" | 
|---|
| 19 | F DVBZ=0:0 S DVBZ=$O(^TMP($J,DVBZ)) Q:'DVBZ  I $D(^(DVBZ,0)) S DCODE=$P(^(0),";;",2) I +DCODE S DTEXT=$P(DCODE,"^",2),DCODE=+DCODE D CHKADD | 
|---|
| 20 | ; | 
|---|
| 21 | W !!?5,"*** " | 
|---|
| 22 | I 'ACNT W "No entry" | 
|---|
| 23 | E  W ACNT," ",$S(ACNT>1:"entries",1:"entry") | 
|---|
| 24 | W " added to file #31 ***",! | 
|---|
| 25 | W !!?5,"*** " | 
|---|
| 26 | ; | 
|---|
| 27 | I 'CCNT W "No entry" | 
|---|
| 28 | E  W CCNT," ",$S(CCNT>1:"entries",1:"entry") | 
|---|
| 29 | W " changed in file #31 ***",! | 
|---|
| 30 | ; | 
|---|
| 31 | S ^XMB(3.9,XMZ,2,0)="^^"_LCNT_"^"_LCNT_"^"_DT_"^" | 
|---|
| 32 | D ENT1^XMD | 
|---|
| 33 | ; | 
|---|
| 34 | KIL K XMDUZ,XMSUB,XMDUN,XMZ,LINE,%I,%N,BL | 
|---|
| 35 | K INT,LCNT,ACNT,CCNT,DCODE,DTEXT,Z,DIE,DIC,DR,DA,DD,D0,DQ,X,Y,DVBZ | 
|---|
| 36 | K ^TMP($J) Q | 
|---|
| 37 | ; | 
|---|
| 38 | CHKADD I '$D(^DIC(31,"C",DCODE)) S DIC("DR")="2///"_DCODE,X=DTEXT K DD,DO D FILE^DICN K DO,DD S ACNT=ACNT+1 D M1 Q | 
|---|
| 39 | ; | 
|---|
| 40 | S INT=0,INT=$O(^DIC(31,"C",DCODE,INT)) I INT,$P(^DIC(31,INT,0),"^")'=DTEXT S DR=".01///"_DTEXT,DA=INT D M2,^DIE S CCNT=CCNT+1 Q | 
|---|
| 41 | ; | 
|---|
| 42 | Q | 
|---|
| 43 | M1 S LINE="'"_DCODE_"'  "_DTEXT_" ...added to file..." D MSET Q | 
|---|
| 44 | ; | 
|---|
| 45 | M2 S LINE=$E(DCODE_" "_$P(^DIC(31,INT,0),"^")_BL,1,37)_"==> "_DTEXT | 
|---|
| 46 | ; | 
|---|
| 47 | MSET S LCNT=LCNT+1,^XMB(3.9,XMZ,2,LCNT,0)=LINE | 
|---|
| 48 | I DCODE#50=0 W "." | 
|---|
| 49 | Q | 
|---|