VPRP31 ;SLC/MRY -- Patch 31 postinit ;2/4/21 12:07
;;1.0;VIRTUAL PATIENT RECORD;**31**;Sep 01, 2011;Build 3
;;Per VHA Directive 6402, this routine should not be modified.
;
POST ; -- post-init
D IDX,CONT
Q
;
IDX ; -- add AVPR index to #8925.7
N VPRX,VPRY
S VPRX("FILE")=8925.7
S VPRX("NAME")="AVPR"
S VPRX("TYPE")="MU"
S VPRX("USE")="A"
S VPRX("EXECUTION")="F"
S VPRX("ACTIVITY")=""
S VPRX("SHORT DESCR")="Trigger updates to VPR"
S VPRX("DESCR",1)="This is an action index that updates the Virtual Patient Record (VPR)"
S VPRX("DESCR",2)="when this record is updated. No actual cross-reference nodes are set"
S VPRX("DESCR",3)="or killed."
S VPRX("SET")="D:$L($T(TIUS^VPREVNT)) TIUS^VPREVNT(DA)"
S VPRX("KILL")="Q"
S VPRX("WHOLE KILL")="Q"
S VPRX("VAL",1)=.04 ;Cosignature date/time
D CREIXN^DDMOD(.VPRX,"kW",.VPRY) ;VPRY=ien^name of index
Q
;
CONT ; -- link new entity to Container file
N DA,DR,DIE,X0,MSG
S DA(1)=+$O(^VPRC(560.1,"B","MEMBER ENROLLMENT",0)) Q:DA(1)<1
S DA=+$O(^VPRC(560.1,"F",2.312,DA(1),0)) Q:DA<1
; already linked?
S X0=$G(^VPRC(560.1,DA(1),1,DA,0))
I $P(X0,U,2)>0,$P(X0,U,3)>0 Q ;ok
; update, add message to Install log
S DIE="^VPRC(560.1,"_DA(1)_",1,"
S DR=".03///VPR DEL INSURANCE" D ^DIE
S X0=$G(^VPRC(560.1,DA(1),1,DA,0)),MSG="Pointer resolution "
S MSG=MSG_$S($P(X0,U,3)<1:"UN",1:"")_"SUCCESSFUL."
D BMES^XPDUTL(MSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRP31 1438 printed Sep 23, 2025@20:22 Page 2
VPRP31 ;SLC/MRY -- Patch 31 postinit ;2/4/21 12:07
+1 ;;1.0;VIRTUAL PATIENT RECORD;**31**;Sep 01, 2011;Build 3
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
POST ; -- post-init
+1 DO IDX
DO CONT
+2 QUIT
+3 ;
IDX ; -- add AVPR index to #8925.7
+1 NEW VPRX,VPRY
+2 SET VPRX("FILE")=8925.7
+3 SET VPRX("NAME")="AVPR"
+4 SET VPRX("TYPE")="MU"
+5 SET VPRX("USE")="A"
+6 SET VPRX("EXECUTION")="F"
+7 SET VPRX("ACTIVITY")=""
+8 SET VPRX("SHORT DESCR")="Trigger updates to VPR"
+9 SET VPRX("DESCR",1)="This is an action index that updates the Virtual Patient Record (VPR)"
+10 SET VPRX("DESCR",2)="when this record is updated. No actual cross-reference nodes are set"
+11 SET VPRX("DESCR",3)="or killed."
+12 SET VPRX("SET")="D:$L($T(TIUS^VPREVNT)) TIUS^VPREVNT(DA)"
+13 SET VPRX("KILL")="Q"
+14 SET VPRX("WHOLE KILL")="Q"
+15 ;Cosignature date/time
SET VPRX("VAL",1)=.04
+16 ;VPRY=ien^name of index
DO CREIXN^DDMOD(.VPRX,"kW",.VPRY)
+17 QUIT
+18 ;
CONT ; -- link new entity to Container file
+1 NEW DA,DR,DIE,X0,MSG
+2 SET DA(1)=+$ORDER(^VPRC(560.1,"B","MEMBER ENROLLMENT",0))
if DA(1)<1
QUIT
+3 SET DA=+$ORDER(^VPRC(560.1,"F",2.312,DA(1),0))
if DA<1
QUIT
+4 ; already linked?
+5 SET X0=$GET(^VPRC(560.1,DA(1),1,DA,0))
+6 ;ok
IF $PIECE(X0,U,2)>0
IF $PIECE(X0,U,3)>0
QUIT
+7 ; update, add message to Install log
+8 SET DIE="^VPRC(560.1,"_DA(1)_",1,"
+9 SET DR=".03///VPR DEL INSURANCE"
DO ^DIE
+10 SET X0=$GET(^VPRC(560.1,DA(1),1,DA,0))
SET MSG="Pointer resolution "
+11 SET MSG=MSG_$SELECT($PIECE(X0,U,3)<1:"UN",1:"")_"SUCCESSFUL."
+12 DO BMES^XPDUTL(MSG)
+13 QUIT
