DVBAPLNG ;ALB/JLU;updates the long description of file 31.;1/18/94
;;2.7;AMIE;;Apr 10, 1995
;
EN I +$$VERSION^DVBAPST1>2.59 DO Q
.S VAR=" - Version 2.6 of AMIE has already been loaded."
.D BUMPBLK^DVBAPOST
.D BUMPBLK^DVBAPOST
.D BUMP^DVBAPOST(VAR)
.W !!,VAR
.S VAR="There is no need to add Long Descriptions to the Disability Condition file."
.D BUMP^DVBAPOST(VAR)
.W !,VAR,!
.D BUMPBLK^DVBAPOST
.Q
D SET ;sets up variables.
D LOOP ;loops through tmp global and adds long desc
D SG1 ;write ending and updates tmp
D EXIT
Q
;
SET S CT=0
S DIE="^DIC(31,"
F LP1=1:1:3 D BUMPBLK^DVBAPOST
S V1=" - Adding Long Description to the Disability Condition file."
W !!!,V1,!
D BUMP^DVBAPOST(V1)
D BUMPBLK^DVBAPOST
SET1 S DIF="^TMP($J,""DVBA"",",XCNP=0
K ^TMP($J,"DVBA")
N R
F R="DVBAPL1","DVBAPL2","DVBAPL3","DVBAPL4","DVBAPL5","DVBAPL6","DVBAPL7","DVBAPL8","DVBAPL9","DVBAPL10" S X=R X ^%ZOSF("LOAD") W "."
K DIF,XCNP,R,X
Q
;
EXIT ;cleans variables and exit.
K CODE,CT,DIE,JA,JB,LP,LP1,V1,TEXT,DIR,^TMP($J,"DVBA")
Q
;
SE ;writes and updates the tmp global with error message.
;
S V1="- Problems exist with the disability condition "_CODE_"."
W !,V1
D BUMP^DVBAPOST(V1)
S V1=" Long description NOT added!"
W !,V1
D BUMP^DVBAPOST(V1)
Q
;
SG1 ;writes and updates the tmp global with the finish.
;
F LP1=1:1:2 D BUMPBLK^DVBAPOST
S V1="I have finished updating the long descriptions of the Disability Condition file!"
W !!,V1
D BUMP^DVBAPOST(V1)
S V1="I updated "_CT_" disabilities."
W !,V1
D BUMP^DVBAPOST(V1)
D BUMPBLK^DVBAPOST
Q
;
LOOP ;loops through tmp and updates file 31 long description field.
;
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
.S TEXT=$P(CODE,";",2)
.S CODE=+CODE
.K STOP
.DO ADCHK
.I $D(STOP) Q
.Q
Q
;
ADCHK ;checks to see if the disability code exists and if it already has a
;long description.
;
I CODE<4900 S STOP=1 Q
I '$D(^DIC(31,"C",CODE)) D SE S STOP=1 Q
S JA=$O(^DIC(31,"C",CODE,""))
I '$D(^DIC(31,JA,0)) D SE S STOP=1 Q
S JB=$G(^DIC(31,JA,1))
I JB=""!($P(JB,U,1)'=TEXT) DO ADD
Q
;
ADD ;adds the long description to file 31 long description field.
;
S DA=JA
S DR="10////"_TEXT
D ^DIE
K DA,DR
S CT=CT+1
W:'(LP#10) "."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAPLNG 2355 printed Oct 16, 2024@17:42:38 Page 2
DVBAPLNG ;ALB/JLU;updates the long description of file 31.;1/18/94
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
EN IF +$$VERSION^DVBAPST1>2.59
Begin DoDot:1
+1 SET VAR=" - Version 2.6 of AMIE has already been loaded."
+2 DO BUMPBLK^DVBAPOST
+3 DO BUMPBLK^DVBAPOST
+4 DO BUMP^DVBAPOST(VAR)
+5 WRITE !!,VAR
+6 SET VAR="There is no need to add Long Descriptions to the Disability Condition file."
+7 DO BUMP^DVBAPOST(VAR)
+8 WRITE !,VAR,!
+9 DO BUMPBLK^DVBAPOST
+10 QUIT
End DoDot:1
QUIT
+11 ;sets up variables.
DO SET
+12 ;loops through tmp global and adds long desc
DO LOOP
+13 ;write ending and updates tmp
DO SG1
+14 DO EXIT
+15 QUIT
+16 ;
SET SET CT=0
+1 SET DIE="^DIC(31,"
+2 FOR LP1=1:1:3
DO BUMPBLK^DVBAPOST
+3 SET V1=" - Adding Long Description to the Disability Condition file."
+4 WRITE !!!,V1,!
+5 DO BUMP^DVBAPOST(V1)
+6 DO BUMPBLK^DVBAPOST
SET1 SET DIF="^TMP($J,""DVBA"","
SET XCNP=0
+1 KILL ^TMP($JOB,"DVBA")
+2 NEW R
+3 FOR R="DVBAPL1","DVBAPL2","DVBAPL3","DVBAPL4","DVBAPL5","DVBAPL6","DVBAPL7","DVBAPL8","DVBAPL9","DVBAPL10"
SET X=R
XECUTE ^%ZOSF("LOAD")
WRITE "."
+4 KILL DIF,XCNP,R,X
+5 QUIT
+6 ;
EXIT ;cleans variables and exit.
+1 KILL CODE,CT,DIE,JA,JB,LP,LP1,V1,TEXT,DIR,^TMP($JOB,"DVBA")
+2 QUIT
+3 ;
SE ;writes and updates the tmp global with error message.
+1 ;
+2 SET V1="- Problems exist with the disability condition "_CODE_"."
+3 WRITE !,V1
+4 DO BUMP^DVBAPOST(V1)
+5 SET V1=" Long description NOT added!"
+6 WRITE !,V1
+7 DO BUMP^DVBAPOST(V1)
+8 QUIT
+9 ;
SG1 ;writes and updates the tmp global with the finish.
+1 ;
+2 FOR LP1=1:1:2
DO BUMPBLK^DVBAPOST
+3 SET V1="I have finished updating the long descriptions of the Disability Condition file!"
+4 WRITE !!,V1
+5 DO BUMP^DVBAPOST(V1)
+6 SET V1="I updated "_CT_" disabilities."
+7 WRITE !,V1
+8 DO BUMP^DVBAPOST(V1)
+9 DO BUMPBLK^DVBAPOST
+10 QUIT
+11 ;
LOOP ;loops through tmp and updates file 31 long description field.
+1 ;
+2 FOR LP=0:0
SET LP=$ORDER(^TMP($JOB,"DVBA",LP))
if LP=""
QUIT
IF $DATA(^(LP,0))
SET CODE=$PIECE(^(0),";;",2)
IF +CODE
Begin DoDot:1
+3 SET TEXT=$PIECE(CODE,";",2)
+4 SET CODE=+CODE
+5 KILL STOP
+6 DO ADCHK
+7 IF $DATA(STOP)
QUIT
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
ADCHK ;checks to see if the disability code exists and if it already has a
+1 ;long description.
+2 ;
+3 IF CODE<4900
SET STOP=1
QUIT
+4 IF '$DATA(^DIC(31,"C",CODE))
DO SE
SET STOP=1
QUIT
+5 SET JA=$ORDER(^DIC(31,"C",CODE,""))
+6 IF '$DATA(^DIC(31,JA,0))
DO SE
SET STOP=1
QUIT
+7 SET JB=$GET(^DIC(31,JA,1))
+8 IF JB=""!($PIECE(JB,U,1)'=TEXT)
DO ADD
+9 QUIT
+10 ;
ADD ;adds the long description to file 31 long description field.
+1 ;
+2 SET DA=JA
+3 SET DR="10////"_TEXT
+4 DO ^DIE
+5 KILL DA,DR
+6 SET CT=CT+1
+7 if '(LP#10)
WRITE "."
+8 QUIT
