source: WorldVistAEHR/trunk/r/HINQ-DVB--DVBA--DVBE--DVBC/DVBHDBA1.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
Line 
1DVBHDBA1 ;pke/isc-albany - Check, add to file 31; 25 AUG 88@12:00
2 ;;V4.0;HINQ;;03/25/92
3EN K DO,DD S U="^" D DT^DICRW
4 ;
5 W !!?5,"*** Updating 'Disability Condition' file #31 ***",!!
6 ;
7ENT 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 ;
17ADD 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 ;
34KIL 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 ;
38CHKADD 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
43M1 S LINE="'"_DCODE_"' "_DTEXT_" ...added to file..." D MSET Q
44 ;
45M2 S LINE=$E(DCODE_" "_$P(^DIC(31,INT,0),"^")_BL,1,37)_"==> "_DTEXT
46 ;
47MSET S LCNT=LCNT+1,^XMB(3.9,XMZ,2,LCNT,0)=LINE
48 I DCODE#50=0 W "."
49 Q
Note: See TracBrowser for help on using the repository browser.