source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAPLNG.m@ 1777

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

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1DVBAPLNG ;ALB/JLU;updates the long description of file 31.;1/18/94
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4EN I +$$VERSION^DVBAPST1>2.59 DO Q
5 .S VAR=" - Version 2.6 of AMIE has already been loaded."
6 .D BUMPBLK^DVBAPOST
7 .D BUMPBLK^DVBAPOST
8 .D BUMP^DVBAPOST(VAR)
9 .W !!,VAR
10 .S VAR="There is no need to add Long Descriptions to the Disability Condition file."
11 .D BUMP^DVBAPOST(VAR)
12 .W !,VAR,!
13 .D BUMPBLK^DVBAPOST
14 .Q
15 D SET ;sets up variables.
16 D LOOP ;loops through tmp global and adds long desc
17 D SG1 ;write ending and updates tmp
18 D EXIT
19 Q
20 ;
21SET S CT=0
22 S DIE="^DIC(31,"
23 F LP1=1:1:3 D BUMPBLK^DVBAPOST
24 S V1=" - Adding Long Description to the Disability Condition file."
25 W !!!,V1,!
26 D BUMP^DVBAPOST(V1)
27 D BUMPBLK^DVBAPOST
28SET1 S DIF="^TMP($J,""DVBA"",",XCNP=0
29 K ^TMP($J,"DVBA")
30 N R
31 F R="DVBAPL1","DVBAPL2","DVBAPL3","DVBAPL4","DVBAPL5","DVBAPL6","DVBAPL7","DVBAPL8","DVBAPL9","DVBAPL10" S X=R X ^%ZOSF("LOAD") W "."
32 K DIF,XCNP,R,X
33 Q
34 ;
35EXIT ;cleans variables and exit.
36 K CODE,CT,DIE,JA,JB,LP,LP1,V1,TEXT,DIR,^TMP($J,"DVBA")
37 Q
38 ;
39SE ;writes and updates the tmp global with error message.
40 ;
41 S V1="- Problems exist with the disability condition "_CODE_"."
42 W !,V1
43 D BUMP^DVBAPOST(V1)
44 S V1=" Long description NOT added!"
45 W !,V1
46 D BUMP^DVBAPOST(V1)
47 Q
48 ;
49SG1 ;writes and updates the tmp global with the finish.
50 ;
51 F LP1=1:1:2 D BUMPBLK^DVBAPOST
52 S V1="I have finished updating the long descriptions of the Disability Condition file!"
53 W !!,V1
54 D BUMP^DVBAPOST(V1)
55 S V1="I updated "_CT_" disabilities."
56 W !,V1
57 D BUMP^DVBAPOST(V1)
58 D BUMPBLK^DVBAPOST
59 Q
60 ;
61LOOP ;loops through tmp and updates file 31 long description field.
62 ;
63 F LP=0:0 S LP=$O(^TMP($J,"DVBA",LP)) Q:LP="" I $D(^(LP,0)) S CODE=$P(^(0),";;",2) I +CODE DO
64 .S TEXT=$P(CODE,";",2)
65 .S CODE=+CODE
66 .K STOP
67 .DO ADCHK
68 .I $D(STOP) Q
69 .Q
70 Q
71 ;
72ADCHK ;checks to see if the disability code exists and if it already has a
73 ;long description.
74 ;
75 I CODE<4900 S STOP=1 Q
76 I '$D(^DIC(31,"C",CODE)) D SE S STOP=1 Q
77 S JA=$O(^DIC(31,"C",CODE,""))
78 I '$D(^DIC(31,JA,0)) D SE S STOP=1 Q
79 S JB=$G(^DIC(31,JA,1))
80 I JB=""!($P(JB,U,1)'=TEXT) DO ADD
81 Q
82 ;
83ADD ;adds the long description to file 31 long description field.
84 ;
85 S DA=JA
86 S DR="10////"_TEXT
87 D ^DIE
88 K DA,DR
89 S CT=CT+1
90 W:'(LP#10) "."
91 Q
Note: See TracBrowser for help on using the repository browser.