Routine: VPRP28

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.

POST ; -- Post install for VPR*1.0*28

 D CONT

 D PCMM^VPRIDX

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRP28   838     printed  Mar 13, 2025@21:50:37                                                                                                                                                                                                       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

VPRP28.m