| 1 | DVBAPLNG ;ALB/JLU;updates the long description of file 31.;1/18/94
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | EN 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 | ;
|
|---|
| 21 | SET 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
|
|---|
| 28 | SET1 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 | ;
|
|---|
| 35 | EXIT ;cleans variables and exit.
|
|---|
| 36 | K CODE,CT,DIE,JA,JB,LP,LP1,V1,TEXT,DIR,^TMP($J,"DVBA")
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | SE ;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 | ;
|
|---|
| 49 | SG1 ;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 | ;
|
|---|
| 61 | LOOP ;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 | ;
|
|---|
| 72 | ADCHK ;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 | ;
|
|---|
| 83 | ADD ;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
|
|---|
