VPRP27 ;SLC/MKB - Postinit for patch VPR*1*27
;;1.0;VIRTUAL PATIENT RECORD;**27**;Sep 01, 2011;Build 10
;;Per VHA Directive 6402, this routine should not be modified.
;
POST ; -- postinit
D XTMP
D DEL
;D PAT
Q
;
XTMP ; -- convert/kill ^XTMP log nodes
N H4,HD,NUM,DFN,X
S H4=($P($H,",")-4)
S HD=0 F S HD=$O(^XTMP("VPRHS",HD)) Q:HD<1 D
. I HD>H4 S NUM=0 F S NUM=$O(^XTMP("VPRHS",HD,NUM)) Q:NUM<1 D
.. S DFN=0 F S DFN=$O(^XTMP("VPRHS",HD,NUM,DFN)) Q:DFN<1 S X=$G(^(DFN)) D
... I '$D(^XTMP("VPRHS-"_HD,0)) S ^XTMP("VPRHS-"_HD,0)=$$HTFM^XLFDT(HD+4)_U_DT_"^VPR update log for HealthShare"
... S ^XTMP("VPRHS-"_HD,NUM,DFN)=X
. K ^XTMP("VPRHS",HD)
Q
;
DEL ; -- link new DEL entities to file
N I,X,NM,FN,DA,DR,DIE
F I=1:1 S X=$P($T(ENT+I),";",3,99) Q:X="ZZZZZ" D
. S NM=$P(X,";"),FN=$P(X,";",2),X=$P(X,";",3) Q:X=""
. S DA(1)=+$O(^VPRC(560.1,"B",NM,0)) Q:DA(1)<1
. S DA=+$O(^VPRC(560.1,"F",FN,DA(1),0)) Q:DA<1
. S DIE="^VPRC(560.1,"_DA(1)_",1,"
. S DR=".03///"_X D ^DIE
Q
ENT ;;CONTAINER;FILE#;DELETE ENTITY
;;DIAGNOSIS;9000010.07;VPR DEL V POV
;;DIAGNOSIS;45;VPR DEL PTF
;;DOCUMENT;8925;VPR DEL TIU DOCUMENT
;;FAMILY HISTORY;9000010.23;VPR DEL FAMILY HX
;;PHYSICAL EXAM;9000010.13;VPR DEL V EXAM
;;PROCEDURE;9000010.18;VPR DEL V CPT
;;SOCIAL HISTORY;9000010.23;VPR DEL SOCIAL HX
;;VACCINATION;9000010.11;VPR DEL VACCINATION
;;VACCINATION;9000010.23;VPR DEL HF VACC REFUSAL
;;ZZZZZ
;
PAT ; -- fix header node for Patient sub-file
N DFN,LAST,TOTAL
S (DFN,TOTAL)=0
F S DFN=$O(^VPR(1,2,DFN)) Q:DFN<1 S LAST=DFN,TOTAL=TOTAL+1
S ^VPR(1,2,0)="^560.02PA^"_LAST_U_TOTAL
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRP27 1654 printed Nov 22, 2024@17:55:26 Page 2
VPRP27 ;SLC/MKB - Postinit for patch VPR*1*27
+1 ;;1.0;VIRTUAL PATIENT RECORD;**27**;Sep 01, 2011;Build 10
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
POST ; -- postinit
+1 DO XTMP
+2 DO DEL
+3 ;D PAT
+4 QUIT
+5 ;
XTMP ; -- convert/kill ^XTMP log nodes
+1 NEW H4,HD,NUM,DFN,X
+2 SET H4=($PIECE($HOROLOG,",")-4)
+3 SET HD=0
FOR
SET HD=$ORDER(^XTMP("VPRHS",HD))
if HD<1
QUIT
Begin DoDot:1
+4 IF HD>H4
SET NUM=0
FOR
SET NUM=$ORDER(^XTMP("VPRHS",HD,NUM))
if NUM<1
QUIT
Begin DoDot:2
+5 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("VPRHS",HD,NUM,DFN))
if DFN<1
QUIT
SET X=$GET(^(DFN))
Begin DoDot:3
+6 IF '$DATA(^XTMP("VPRHS-"_HD,0))
SET ^XTMP("VPRHS-"_HD,0)=$$HTFM^XLFDT(HD+4)_U_DT_"^VPR update log for HealthShare"
+7 SET ^XTMP("VPRHS-"_HD,NUM,DFN)=X
End DoDot:3
End DoDot:2
+8 KILL ^XTMP("VPRHS",HD)
End DoDot:1
+9 QUIT
+10 ;
DEL ; -- link new DEL entities to file
+1 NEW I,X,NM,FN,DA,DR,DIE
+2 FOR I=1:1
SET X=$PIECE($TEXT(ENT+I),";",3,99)
if X="ZZZZZ"
QUIT
Begin DoDot:1
+3 SET NM=$PIECE(X,";")
SET FN=$PIECE(X,";",2)
SET X=$PIECE(X,";",3)
if X=""
QUIT
+4 SET DA(1)=+$ORDER(^VPRC(560.1,"B",NM,0))
if DA(1)<1
QUIT
+5 SET DA=+$ORDER(^VPRC(560.1,"F",FN,DA(1),0))
if DA<1
QUIT
+6 SET DIE="^VPRC(560.1,"_DA(1)_",1,"
+7 SET DR=".03///"_X
DO ^DIE
End DoDot:1
+8 QUIT
ENT ;;CONTAINER;FILE#;DELETE ENTITY
+1 ;;DIAGNOSIS;9000010.07;VPR DEL V POV
+2 ;;DIAGNOSIS;45;VPR DEL PTF
+3 ;;DOCUMENT;8925;VPR DEL TIU DOCUMENT
+4 ;;FAMILY HISTORY;9000010.23;VPR DEL FAMILY HX
+5 ;;PHYSICAL EXAM;9000010.13;VPR DEL V EXAM
+6 ;;PROCEDURE;9000010.18;VPR DEL V CPT
+7 ;;SOCIAL HISTORY;9000010.23;VPR DEL SOCIAL HX
+8 ;;VACCINATION;9000010.11;VPR DEL VACCINATION
+9 ;;VACCINATION;9000010.23;VPR DEL HF VACC REFUSAL
+10 ;;ZZZZZ
+11 ;
PAT ; -- fix header node for Patient sub-file
+1 NEW DFN,LAST,TOTAL
+2 SET (DFN,TOTAL)=0
+3 FOR
SET DFN=$ORDER(^VPR(1,2,DFN))
if DFN<1
QUIT
SET LAST=DFN
SET TOTAL=TOTAL+1
+4 SET ^VPR(1,2,0)="^560.02PA^"_LAST_U_TOTAL
+5 QUIT
