- DVBHDBA1 ;pke/isc-albany - Check, add to file 31; 25 AUG 88@12:00
- ;;V4.0;HINQ;;03/25/92
- EN K DO,DD S U="^" D DT^DICRW
- ;
- W !!?5,"*** Updating 'Disability Condition' file #31 ***",!!
- ;
- ENT S DIF="^TMP($J,",XCNP=0 K ^TMP($J)
- F ROU="DVBHDBA2","DVBHDBA3","DVBHDBA4","DVBHDBA5","DVBHDBA6","DVBHDBA7","DVBHDBA8","DVBHDBA9","DVBHDBAA","DVBHDBAB" S X=ROU X ^%ZOSF("LOAD") W ".."
- K DIF,XCNP,ROU
- ;
- S XMSUB="Disability Condition file #31 Changes",XMDUN="HINQ update"
- I $D(DUZ)#2,DUZ S XMDUZ=DUZ
- E S XMDUZ=.5
- S XMY(XMDUZ)=""
- D GET^XMA2
- ;
- ADD S (LCNT,ACNT,CCNT)=0,$P(BL," ",40)="" W !!
- S (DIE,DIC)="^DIC(31,",DIC(0)="L"
- 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
- ;
- W !!?5,"*** "
- I 'ACNT W "No entry"
- E W ACNT," ",$S(ACNT>1:"entries",1:"entry")
- W " added to file #31 ***",!
- W !!?5,"*** "
- ;
- I 'CCNT W "No entry"
- E W CCNT," ",$S(CCNT>1:"entries",1:"entry")
- W " changed in file #31 ***",!
- ;
- S ^XMB(3.9,XMZ,2,0)="^^"_LCNT_"^"_LCNT_"^"_DT_"^"
- D ENT1^XMD
- ;
- KIL K XMDUZ,XMSUB,XMDUN,XMZ,LINE,%I,%N,BL
- K INT,LCNT,ACNT,CCNT,DCODE,DTEXT,Z,DIE,DIC,DR,DA,DD,D0,DQ,X,Y,DVBZ
- K ^TMP($J) Q
- ;
- 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
- ;
- 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
- ;
- Q
- M1 S LINE="'"_DCODE_"' "_DTEXT_" ...added to file..." D MSET Q
- ;
- M2 S LINE=$E(DCODE_" "_$P(^DIC(31,INT,0),"^")_BL,1,37)_"==> "_DTEXT
- ;
- MSET S LCNT=LCNT+1,^XMB(3.9,XMZ,2,LCNT,0)=LINE
- I DCODE#50=0 W "."
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBHDBA1 1703 printed Mar 13, 2025@21:03:10 Page 2
- DVBHDBA1 ;pke/isc-albany - Check, add to file 31; 25 AUG 88@12:00
- +1 ;;V4.0;HINQ;;03/25/92
- EN KILL DO,DD
- SET U="^"
- DO DT^DICRW
- +1 ;
- +2 WRITE !!?5,"*** Updating 'Disability Condition' file #31 ***",!!
- +3 ;
- ENT SET DIF="^TMP($J,"
- SET XCNP=0
- KILL ^TMP($JOB)
- +1 FOR ROU="DVBHDBA2","DVBHDBA3","DVBHDBA4","DVBHDBA5","DVBHDBA6","DVBHDBA7","DVBHDBA8","DVBHDBA9","DVBHDBAA","DVBHDBAB"
- SET X=ROU
- XECUTE ^%ZOSF("LOAD")
- WRITE ".."
- +2 KILL DIF,XCNP,ROU
- +3 ;
- +4 SET XMSUB="Disability Condition file #31 Changes"
- SET XMDUN="HINQ update"
- +5 IF $DATA(DUZ)#2
- IF DUZ
- SET XMDUZ=DUZ
- +6 IF '$TEST
- SET XMDUZ=.5
- +7 SET XMY(XMDUZ)=""
- +8 DO GET^XMA2
- +9 ;
- ADD SET (LCNT,ACNT,CCNT)=0
- SET $PIECE(BL," ",40)=""
- WRITE !!
- +1 SET (DIE,DIC)="^DIC(31,"
- SET DIC(0)="L"
- +2 FOR DVBZ=0:0
- SET DVBZ=$ORDER(^TMP($JOB,DVBZ))
- if 'DVBZ
- QUIT
- IF $DATA(^(DVBZ,0))
- SET DCODE=$PIECE(^(0),";;",2)
- IF +DCODE
- SET DTEXT=$PIECE(DCODE,"^",2)
- SET DCODE=+DCODE
- DO CHKADD
- +3 ;
- +4 WRITE !!?5,"*** "
- +5 IF 'ACNT
- WRITE "No entry"
- +6 IF '$TEST
- WRITE ACNT," ",$SELECT(ACNT>1:"entries",1:"entry")
- +7 WRITE " added to file #31 ***",!
- +8 WRITE !!?5,"*** "
- +9 ;
- +10 IF 'CCNT
- WRITE "No entry"
- +11 IF '$TEST
- WRITE CCNT," ",$SELECT(CCNT>1:"entries",1:"entry")
- +12 WRITE " changed in file #31 ***",!
- +13 ;
- +14 SET ^XMB(3.9,XMZ,2,0)="^^"_LCNT_"^"_LCNT_"^"_DT_"^"
- +15 DO ENT1^XMD
- +16 ;
- KIL KILL XMDUZ,XMSUB,XMDUN,XMZ,LINE,%I,%N,BL
- +1 KILL INT,LCNT,ACNT,CCNT,DCODE,DTEXT,Z,DIE,DIC,DR,DA,DD,D0,DQ,X,Y,DVBZ
- +2 KILL ^TMP($JOB)
- QUIT
- +3 ;
- CHKADD IF '$DATA(^DIC(31,"C",DCODE))
- SET DIC("DR")="2///"_DCODE
- SET X=DTEXT
- KILL DD,DO
- DO FILE^DICN
- KILL DO,DD
- SET ACNT=ACNT+1
- DO M1
- QUIT
- +1 ;
- +2 SET INT=0
- SET INT=$ORDER(^DIC(31,"C",DCODE,INT))
- IF INT
- IF $PIECE(^DIC(31,INT,0),"^")'=DTEXT
- SET DR=".01///"_DTEXT
- SET DA=INT
- DO M2
- DO ^DIE
- SET CCNT=CCNT+1
- QUIT
- +3 ;
- +4 QUIT
- M1 SET LINE="'"_DCODE_"' "_DTEXT_" ...added to file..."
- DO MSET
- QUIT
- +1 ;
- M2 SET LINE=$EXTRACT(DCODE_" "_$PIECE(^DIC(31,INT,0),"^")_BL,1,37)_"==> "_DTEXT
- +1 ;
- MSET SET LCNT=LCNT+1
- SET ^XMB(3.9,XMZ,2,LCNT,0)=LINE
- +1 IF DCODE#50=0
- WRITE "."
- +2 QUIT
