VPRP28 ;SLC/BLJ -- SDA utilities for patch 28 ;8/18/21 14:21
;;1.0;VIRTUAL PATIENT RECORD;**28**;Aug 18, 2021;Build 6
;;Per VHA Directive 6402, this routine should not be modified.
;
Q
;
POST ; -- Post install for VPR*1.0*28
D CONT
D PCMM^VPRIDX
;
Q
;
CONT ; -- link new entities to Container file
N DA,DR,DIE,X0,MSG
S DA(1)=+$O(^VPRC(560.1,"B","VACCINATION",0)) Q:DA(1)<1
S DA=+$O(^VPRC(560.1,"F",9000010.707,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=".02///VPR ICR EVENT;.03///VPR DEL ICR" D ^DIE
S X0=$G(^VPRC(560.1,DA(1),1,DA,0)),MSG="Pointer resolution "
S MSG=MSG_$S($P(X0,U,2)<1:"UN",$P(X0,U,3)<1:"UN",1:"")_"SUCCESSFUL."
D BMES^XPDUTL(MSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRP28 838 printed Dec 13, 2024@02:45:35 Page 2
VPRP28 ;SLC/BLJ -- SDA utilities for patch 28 ;8/18/21 14:21
+1 ;;1.0;VIRTUAL PATIENT RECORD;**28**;Aug 18, 2021;Build 6
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
POST ; -- Post install for VPR*1.0*28
+1 DO CONT
+2 DO PCMM^VPRIDX
+3 ;
+4 QUIT
+5 ;
CONT ; -- link new entities to Container file
+1 NEW DA,DR,DIE,X0,MSG
+2 SET DA(1)=+$ORDER(^VPRC(560.1,"B","VACCINATION",0))
if DA(1)<1
QUIT
+3 SET DA=+$ORDER(^VPRC(560.1,"F",9000010.707,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=".02///VPR ICR EVENT;.03///VPR DEL ICR"
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,2)<1:"UN",$PIECE(X0,U,3)<1:"UN",1:"")_"SUCCESSFUL."
+12 DO BMES^XPDUTL(MSG)
+13 QUIT
