VPRP14.m

VPRP14 ;SLC/MKB -- Inits for patch 14 ;3/4/20  12:07

 ;;1.0;VIRTUAL PATIENT RECORD;**14**;Sep 01, 2011;Build 38

 ;;Per VHA Directive 6402, this routine should not be modified.

 ;

 ;

PRE ; -- preinit to remove unused Entities

 N DIK,DA,VPRNM,X,DR,DIE,XQORM

 ; remove any old PLI patch entities

 S DIK="^DDE(",VPRNM="VPR P14 A"

 F  S VPRNM=$O(^DDE("B",VPRNM)) Q:VPRNM'?1"VPR P"2N1" "1.E  S DA=+$O(^(VPRNM,0)) I DA D ^DIK

 ; remove Social Hx items from test

 ; S DIK="^DDE(",VPRNM="VPR SHX A"

 ; F  S VPRNM=$O(^DDE("B",VPRNM)) Q:VPRNM'?1"VPR SHX "1.E  S DA=+$O(^(VPRNM,0)) I DA D ^DIK

P1 ; add Seq# to VPR item on PS event

 S X=+$O(^ORD(101,"B","VPR XQOR EVENTS",0))

 S DA(1)=+$O(^ORD(101,"B","PS EVSEND OR",0))

 S DA=+$O(^ORD(101,DA(1),10,"B",X,0))

 I DA,+$G(^ORD(101,DA(1),10,DA,0))=X,'$P(^(0),U,3) D

 . S DR="3///2",DIE="^ORD(101,"_DA(1)_",10," D ^DIE

 . S XQORM=DA(1)_";ORD(101," D XREF^XQORM

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VPRP14   918     printed  Apr 09, 2024@21:47:02                                                                                                                                                                                                       Page 2

VPRP14    ;SLC/MKB -- Inits for patch 14 ;3/4/20  12:07

 +1       ;;1.0;VIRTUAL PATIENT RECORD;**14**;Sep 01, 2011;Build 38

 +2       ;;Per VHA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ;

PRE       ; -- preinit to remove unused Entities

 +1        NEW DIK,DA,VPRNM,X,DR,DIE,XQORM

 +2       ; remove any old PLI patch entities

 +3        SET DIK="^DDE("

           SET VPRNM="VPR P14 A"

 +4        FOR 

               SET VPRNM=$ORDER(^DDE("B",VPRNM))

               if VPRNM'?1"VPR P"2N1" "1.E

                   QUIT 

               SET DA=+$ORDER(^(VPRNM,0))

               IF DA

                   DO ^DIK

 +5       ; remove Social Hx items from test

 +6       ; S DIK="^DDE(",VPRNM="VPR SHX A"

 +7       ; F  S VPRNM=$O(^DDE("B",VPRNM)) Q:VPRNM'?1"VPR SHX "1.E  S DA=+$O(^(VPRNM,0)) I DA D ^DIK

P1        ; add Seq# to VPR item on PS event

 +1        SET X=+$ORDER(^ORD(101,"B","VPR XQOR EVENTS",0))

 +2        SET DA(1)=+$ORDER(^ORD(101,"B","PS EVSEND OR",0))

 +3        SET DA=+$ORDER(^ORD(101,DA(1),10,"B",X,0))

 +4        IF DA

               IF +$GET(^ORD(101,DA(1),10,DA,0))=X

                   IF '$PIECE(^(0),U,3)

                       Begin DoDot:1

 +5                        SET DR="3///2"

                           SET DIE="^ORD(101,"_DA(1)_",10,"

                           DO ^DIE

 +6                        SET XQORM=DA(1)_";ORD(101,"

                           DO XREF^XQORM

                       End DoDot:1

 +7        QUIT