RT200 ;PKE/TROY; clean up 2 old DIC(3,16 references for va200
;;2.0;Record Tracking;**29**;10/22/91
;
; fix 194.5,46 REQUESTING USER for executable code to dic(3
; fix 194.5,7 AGE for person multiple in 194.51
;
CHKPTS ;Create check points for post-init
;Input : All variables set by KIDS
;Output : None
;
;Declare variables
N TMP
;Create check points
;
;Change REQUESTING USER entry #46 in file 194.5
S TMP=$$NEWCP^XPDUTL("RT46","EN46^RT200")
;
;Change AGE entry #7 in file 194.5
S TMP=$$NEWCP^XPDUTL("RT7","EN7^RT200")
Q
;
;
EN46 ;checkpoint entry
N OFIELD,NFIELD,DR,DA,DIC,DIE,X,Y
;
S DIC="^DIC(194.5,",DIC(0)="X",X="REQUESTING USER"
D ^DIC
I Y'>0 DO QUIT
.D BMES^XPDUTL(">>> REQUESTING USER entry NOT found in File #194.5")
.D BMES^XPDUTL(">>> Please check entry names and/or cross-references")
.;
;
S DA=+Y
;
S OFIELD="S RTV(RTJ)=$S($D(^DIC(3,+$P(RTQ,""^"",3),0)):$P(^(0),""^""),1:"_"""UNKNOWN"""_")"
S NFIELD="S RTV(RTJ)=$S($D(^VA(200,+$P(RTQ,""^"",3),0)):$P(^(0),""^""),1:"_"""UNKNOWN"""_")"
;
;if entry has dic(3 change it to va(200
I $G(^DIC(194.5,DA,"E"))=OFIELD DO
. S DIE="^DIC(194.5,"
. S DR="100///^S X=NFIELD"
. D ^DIE
. I $G(^DIC(194.5,DA,"E"))=NFIELD DO
. . D BMES^XPDUTL(">>> MUMPS CODE TO SET VARIABLE field in REQUESTING USER entry in file #194.5")
. . D BMES^XPDUTL(">>> was updated to use ^VA(200.")
;
I $G(^DIC(194.5,DA,"E"))'=NFIELD DO
. D BMES^XPDUTL(">>> MUMPS CODE TO SET VARIABLE field for REQUESTING USER' entry in file 194.5")
. D BMES^XPDUTL(">>> not found OR doesn't match patch distribution. Please check this entry.")
;
QUIT
;
;
EN7 ;checkpoint entry
N RTDA,DINUM,DLAGO,DR,DA,DIC,DIE,X,Y
;
S DIC="^DIC(194.5,",DIC(0)="X",X="AGE"
D ^DIC
I Y'>0 DO QUIT
.D BMES^XPDUTL(">>> AGE entry NOT found in File #194.5")
.D BMES^XPDUTL(">>> Please check entry names and/or cross-references")
;
S (RTDA,DA)=+Y
;
; if new person entry missing, addit
I '$D(^DIC(194.5,DA,50,200,0)) DO
. K DD,DO
. S DIC="^DIC(194.5,"_DA_",50,"
. S DIC("P")=$P($G(^DD(194.5,50,0)),U,2)
. S DIC(0)="L"
. S DA(1)=DA
. S DINUM=200
. S DA="200"
. S X="200"
. S DLAGO=194.51
. S DIC("DR")="2///5"
. D FILE^DICN
.;
. I Y'>0 DO QUIT
. . D BMES^XPDUTL(">>> Failed to add NEW PERSON entry in PARENT FILE multiple for the")
. . D BMES^XPDUTL(">>> AGE entry in file #194.5")
.;
. I $P(Y,"^",3) DO
. . D BMES^XPDUTL(">>> Added NEW PERSON entry to PARENT FILE multiple in AGE entry in file #194.5")
;
S DA=RTDA
;if PERSON entry get rid of it
I $D(^DIC(194.5,DA,50,16,0)) DO
. S DA(1)=DA,DIK="^DIC(194.5,"_DA_",50,"
. S DA=16
. D ^DIK
. K DIK
.;
. I '$D(^DIC(194.5,DA,50,16,0)) DO
. . D BMES^XPDUTL(">>> Removed PERSON entry from PARENT FILE multiple of AGE entry in file #194.5")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRT200 2863 printed Dec 13, 2024@02:33:24 Page 2
RT200 ;PKE/TROY; clean up 2 old DIC(3,16 references for va200
+1 ;;2.0;Record Tracking;**29**;10/22/91
+2 ;
+3 ; fix 194.5,46 REQUESTING USER for executable code to dic(3
+4 ; fix 194.5,7 AGE for person multiple in 194.51
+5 ;
CHKPTS ;Create check points for post-init
+1 ;Input : All variables set by KIDS
+2 ;Output : None
+3 ;
+4 ;Declare variables
+5 NEW TMP
+6 ;Create check points
+7 ;
+8 ;Change REQUESTING USER entry #46 in file 194.5
+9 SET TMP=$$NEWCP^XPDUTL("RT46","EN46^RT200")
+10 ;
+11 ;Change AGE entry #7 in file 194.5
+12 SET TMP=$$NEWCP^XPDUTL("RT7","EN7^RT200")
+13 QUIT
+14 ;
+15 ;
EN46 ;checkpoint entry
+1 NEW OFIELD,NFIELD,DR,DA,DIC,DIE,X,Y
+2 ;
+3 SET DIC="^DIC(194.5,"
SET DIC(0)="X"
SET X="REQUESTING USER"
+4 DO ^DIC
+5 IF Y'>0
Begin DoDot:1
+6 DO BMES^XPDUTL(">>> REQUESTING USER entry NOT found in File #194.5")
+7 DO BMES^XPDUTL(">>> Please check entry names and/or cross-references")
+8 ;
End DoDot:1
QUIT
+9 ;
+10 SET DA=+Y
+11 ;
+12 SET OFIELD="S RTV(RTJ)=$S($D(^DIC(3,+$P(RTQ,""^"",3),0)):$P(^(0),""^""),1:"_"""UNKNOWN"""_")"
+13 SET NFIELD="S RTV(RTJ)=$S($D(^VA(200,+$P(RTQ,""^"",3),0)):$P(^(0),""^""),1:"_"""UNKNOWN"""_")"
+14 ;
+15 ;if entry has dic(3 change it to va(200
+16 IF $GET(^DIC(194.5,DA,"E"))=OFIELD
Begin DoDot:1
+17 SET DIE="^DIC(194.5,"
+18 SET DR="100///^S X=NFIELD"
+19 DO ^DIE
+20 IF $GET(^DIC(194.5,DA,"E"))=NFIELD
Begin DoDot:2
+21 DO BMES^XPDUTL(">>> MUMPS CODE TO SET VARIABLE field in REQUESTING USER entry in file #194.5")
+22 DO BMES^XPDUTL(">>> was updated to use ^VA(200.")
End DoDot:2
End DoDot:1
+23 ;
+24 IF $GET(^DIC(194.5,DA,"E"))'=NFIELD
Begin DoDot:1
+25 DO BMES^XPDUTL(">>> MUMPS CODE TO SET VARIABLE field for REQUESTING USER' entry in file 194.5")
+26 DO BMES^XPDUTL(">>> not found OR doesn't match patch distribution. Please check this entry.")
End DoDot:1
+27 ;
+28 QUIT
+29 ;
+30 ;
EN7 ;checkpoint entry
+1 NEW RTDA,DINUM,DLAGO,DR,DA,DIC,DIE,X,Y
+2 ;
+3 SET DIC="^DIC(194.5,"
SET DIC(0)="X"
SET X="AGE"
+4 DO ^DIC
+5 IF Y'>0
Begin DoDot:1
+6 DO BMES^XPDUTL(">>> AGE entry NOT found in File #194.5")
+7 DO BMES^XPDUTL(">>> Please check entry names and/or cross-references")
End DoDot:1
QUIT
+8 ;
+9 SET (RTDA,DA)=+Y
+10 ;
+11 ; if new person entry missing, addit
+12 IF '$DATA(^DIC(194.5,DA,50,200,0))
Begin DoDot:1
+13 KILL DD,DO
+14 SET DIC="^DIC(194.5,"_DA_",50,"
+15 SET DIC("P")=$PIECE($GET(^DD(194.5,50,0)),U,2)
+16 SET DIC(0)="L"
+17 SET DA(1)=DA
+18 SET DINUM=200
+19 SET DA="200"
+20 SET X="200"
+21 SET DLAGO=194.51
+22 SET DIC("DR")="2///5"
+23 DO FILE^DICN
+24 ;
+25 IF Y'>0
Begin DoDot:2
+26 DO BMES^XPDUTL(">>> Failed to add NEW PERSON entry in PARENT FILE multiple for the")
+27 DO BMES^XPDUTL(">>> AGE entry in file #194.5")
End DoDot:2
QUIT
+28 ;
+29 IF $PIECE(Y,"^",3)
Begin DoDot:2
+30 DO BMES^XPDUTL(">>> Added NEW PERSON entry to PARENT FILE multiple in AGE entry in file #194.5")
End DoDot:2
End DoDot:1
+31 ;
+32 SET DA=RTDA
+33 ;if PERSON entry get rid of it
+34 IF $DATA(^DIC(194.5,DA,50,16,0))
Begin DoDot:1
+35 SET DA(1)=DA
SET DIK="^DIC(194.5,"_DA_",50,"
+36 SET DA=16
+37 DO ^DIK
+38 KILL DIK
+39 ;
+40 IF '$DATA(^DIC(194.5,DA,50,16,0))
Begin DoDot:2
+41 DO BMES^XPDUTL(">>> Removed PERSON entry from PARENT FILE multiple of AGE entry in file #194.5")
End DoDot:2
End DoDot:1
+42 QUIT
