PX1P225 ;ALB/TXH - Update CVX Code; May 18, 2020@14:52
;;1.0;PCE PATIENT CARE ENCOUNTER;**225**;Aug 12, 1996;Build 4
;
; This routine updates local entries that have no CVX code mapped
; regardless of case in the IMMUNIZATION file (#9999999.14).
;
Q
;
PRETRAN ; Load CVX code table into KIDS build
;
M @XPDGREF@("PXVCVX")=^XTMP("PXVCVX")
Q
;
POST ; Post installation processes
;
D BMES^XPDUTL("*** PX*1.0*225 Post-Install started ***")
D MES^XPDUTL(" ")
N D0,DA,DIE,DR,PXCVX,PXI,PXII,PXNM,PXVC,PXNAME
D LOAD
D UPD
D BMES^XPDUTL("*** PX*1.0*225 Post-Install completed ***")
D MES^XPDUTL(" ")
Q
;
LOAD ; Load local immunization with CVX code provided by VHA SMEs
;
K ^XTMP("PXVCVX")
M ^XTMP("PXVCVX")=@XPDGREF@("PXVCVX")
I '$D(^XTMP("PXVCVX")) W !,"Mapping table not loaded - INSTALLATION ABORTED" S XPDQUIT=2 Q
; Set auto-delete date from XTMP global - purge dt/creation dt
S ^XTMP("PXVCVX",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^Patch PX*1.0*225 Gold CVX Codes"
; abort installation if error loading table
I +$G(XPDQUIT) Q
Q
;
UPD ; Read local immunization from XTMP and update local entries that
; have no CVX code mapped regardless of case in the IMMUNIZATION file.
;
N PXI,PXREC,PXNM,PXVIEN,PXNAME,D0,PXCVX,DA,DR,DIE,PXCNT
S PXCNT=0
; Get name from ^XTMP("PXVCVX")
F PXI=0:0 S PXI=$O(^XTMP("PXVCVX",PXI)) Q:PXI'>0 D
. S PXREC=$G(^XTMP("PXVCVX",PXI))
. S PXNM=$P(PXREC,U,1)
. ; Get name from ^AUTTIMM
. F PXVIEN=0:0 S PXVIEN=$O(^AUTTIMM("B",PXNM,PXVIEN)) Q:PXVIEN="" D
. . S PXNAME=$P($G(^AUTTIMM(PXVIEN,0)),U,1)
. . ; Compare names in upper case
. . I $$UP^XLFSTR(PXNM)=$$UP^XLFSTR(PXNAME) D
. . . ; check if it is local
. . . S D0=0 S D0=$O(^AUTTIMM("B",PXNAME,D0)) Q:D0="" D
. . . . I $G(^AUTTIMM(D0,100))="L" D ADDCVX
;
D BMES^XPDUTL(" Total "_PXCNT_" CVX codes have been updated at your site.")
Q
;
ADDCVX ; Update CVX code
;
I $P(^AUTTIMM(D0,0),U,3)'="" Q
S PXCVX=$P(PXREC,U,2)
I $L(PXCVX)=1 S PXCVX="0"_PXCVX ; append zero if only 1 digit
S DA=D0,DR=".03////^S X=PXCVX",DIE=9999999.14
D ^DIE
D MES^XPDUTL(" Update CVX code for local entry "_PXNM)
S PXCNT=PXCNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPX1P225 2204 printed Apr 09, 2024@21:34:34 Page 2
PX1P225 ;ALB/TXH - Update CVX Code; May 18, 2020@14:52
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**225**;Aug 12, 1996;Build 4
+2 ;
+3 ; This routine updates local entries that have no CVX code mapped
+4 ; regardless of case in the IMMUNIZATION file (#9999999.14).
+5 ;
+6 QUIT
+7 ;
PRETRAN ; Load CVX code table into KIDS build
+1 ;
+2 MERGE @XPDGREF@("PXVCVX")=^XTMP("PXVCVX")
+3 QUIT
+4 ;
POST ; Post installation processes
+1 ;
+2 DO BMES^XPDUTL("*** PX*1.0*225 Post-Install started ***")
+3 DO MES^XPDUTL(" ")
+4 NEW D0,DA,DIE,DR,PXCVX,PXI,PXII,PXNM,PXVC,PXNAME
+5 DO LOAD
+6 DO UPD
+7 DO BMES^XPDUTL("*** PX*1.0*225 Post-Install completed ***")
+8 DO MES^XPDUTL(" ")
+9 QUIT
+10 ;
LOAD ; Load local immunization with CVX code provided by VHA SMEs
+1 ;
+2 KILL ^XTMP("PXVCVX")
+3 MERGE ^XTMP("PXVCVX")=@XPDGREF@("PXVCVX")
+4 IF '$DATA(^XTMP("PXVCVX"))
WRITE !,"Mapping table not loaded - INSTALLATION ABORTED"
SET XPDQUIT=2
QUIT
+5 ; Set auto-delete date from XTMP global - purge dt/creation dt
+6 SET ^XTMP("PXVCVX",0)=$$FMADD^XLFDT(DT,30)_"^"_DT_"^Patch PX*1.0*225 Gold CVX Codes"
+7 ; abort installation if error loading table
+8 IF +$GET(XPDQUIT)
QUIT
+9 QUIT
+10 ;
UPD ; Read local immunization from XTMP and update local entries that
+1 ; have no CVX code mapped regardless of case in the IMMUNIZATION file.
+2 ;
+3 NEW PXI,PXREC,PXNM,PXVIEN,PXNAME,D0,PXCVX,DA,DR,DIE,PXCNT
+4 SET PXCNT=0
+5 ; Get name from ^XTMP("PXVCVX")
+6 FOR PXI=0:0
SET PXI=$ORDER(^XTMP("PXVCVX",PXI))
if PXI'>0
QUIT
Begin DoDot:1
+7 SET PXREC=$GET(^XTMP("PXVCVX",PXI))
+8 SET PXNM=$PIECE(PXREC,U,1)
+9 ; Get name from ^AUTTIMM
+10 FOR PXVIEN=0:0
SET PXVIEN=$ORDER(^AUTTIMM("B",PXNM,PXVIEN))
if PXVIEN=""
QUIT
Begin DoDot:2
+11 SET PXNAME=$PIECE($GET(^AUTTIMM(PXVIEN,0)),U,1)
+12 ; Compare names in upper case
+13 IF $$UP^XLFSTR(PXNM)=$$UP^XLFSTR(PXNAME)
Begin DoDot:3
+14 ; check if it is local
+15 SET D0=0
SET D0=$ORDER(^AUTTIMM("B",PXNAME,D0))
if D0=""
QUIT
Begin DoDot:4
+16 IF $GET(^AUTTIMM(D0,100))="L"
DO ADDCVX
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 DO BMES^XPDUTL(" Total "_PXCNT_" CVX codes have been updated at your site.")
+19 QUIT
+20 ;
ADDCVX ; Update CVX code
+1 ;
+2 IF $PIECE(^AUTTIMM(D0,0),U,3)'=""
QUIT
+3 SET PXCVX=$PIECE(PXREC,U,2)
+4 ; append zero if only 1 digit
IF $LENGTH(PXCVX)=1
SET PXCVX="0"_PXCVX
+5 SET DA=D0
SET DR=".03////^S X=PXCVX"
SET DIE=9999999.14
+6 DO ^DIE
+7 DO MES^XPDUTL(" Update CVX code for local entry "_PXNM)
+8 SET PXCNT=PXCNT+1
+9 QUIT
