Routine: RT200

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")

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")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRT200   2863     printed  Feb 18, 2025@23:59:55                                                                                                                                                                                                       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

RT200.m