PXVP210 ;BPOIFO/LMT - PX*1*210 KIDS Routine ;11/03/15 16:47
;;1.0;PCE PATIENT CARE ENCOUNTER;**210**;Aug 12, 1996;Build 21
;
; Reference to ^PXRMINDX(9000010.11) supported by ICR #4290 and #4114
; Reference to INDEXD^PXRMDIEV supported by ICR #6059
; Reference to ^DD(9000010.11,.01,12) and ^DD(9000010.11,.01,12.1) supported by ICR #6256
;
Q
;
PRE ; pre-install entry for patch PX*1*210
N DIK,DA
;
; delete AC, AHR1 and AHR2 x-refs from V IMMUNIZATION file if they exist
K DIK,DA S DIK="^DD(9000010.11,.01,1,",DA=4,DA(1)=.01,DA(2)=9000010.11 D ^DIK ; AC
K DIK,DA S DIK="^DD(9000010.11,1201,1,",DA=2,DA(1)=1201,DA(2)=9000010.11 D ^DIK ; AHR1
K DIK,DA S DIK="^DD(9000010.11,1403,1,",DA=2,DA(1)=1403,DA(2)=9000010.11 D ^DIK ; AHR2
; delete AC, AHR1 and AHR2 x-refs from V SKIN TEST file if they exist
K DIK,DA S DIK="^DD(9000010.12,.01,1,",DA=4,DA(1)=.01,DA(2)=9000010.12 D ^DIK ; AC
K DIK,DA S DIK="^DD(9000010.12,.06,1,",DA=2,DA(1)=.06,DA(2)=9000010.12 D ^DIK ; AHR2
K DIK,DA S DIK="^DD(9000010.12,1201,1,",DA=2,DA(1)=1201,DA(2)=9000010.12 D ^DIK ; AHR1
; delete AU, AU1 and AU2 x-refs from IMMUNIZATION LOT file if they exist
K DIK,DA S DIK="^DD(9999999.41,.01,1,",DA=2,DA(1)=.01,DA(2)=9999999.41 D ^DIK ; AU
K DIK,DA S DIK="^DD(9999999.41,.02,1,",DA=1,DA(1)=.02,DA(2)=9999999.41 D ^DIK ; AU1
K DIK,DA S DIK="^DD(9999999.41,.04,1,",DA=2,DA(1)=.04,DA(2)=9999999.41 D ^DIK ; AU2
Q
;
POST ; KIDS Post install for PX*1*210
D BMES("*** Post install started ***")
;
D CVIMMXR ; Update ACR cross-reference on V IMMUNIZATION file
D CIMMXR ; Create ACR cross-reference on IMMUNIZATION file
D BLDVIMM ; Rebuild Clinical Reminder index on V Immunization file
D DDSEC ; Update DD security on Immunization and Skin Test files
D TSKDSG ; Task job to split Dosage into Dose and Units
D MVDIAGS ; Move diagnosis data from old fields to new fields
D DELSCRN ; Delete screen nodes from V Immunization .01 DD
;
D BMES("*** Post install completed ***")
Q
;
CVIMMXR ; Update ACR cross-reference on V IMMUNIZATION file
N PXERR,PXXR,PXRES
;
D BMES("*** Updating ACR cross-reference on V IMMUNIZATION file ***")
;
S PXXR("FILE")=9000010.11
S PXXR("NAME")="ACR"
S PXXR("TYPE")="MU"
S PXXR("USE")="A"
S PXXR("EXECUTION")="R"
S PXXR("ACTIVITY")="IR"
S PXXR("SHORT DESCR")="Clinical Reminders index."
S PXXR("DESCR",1)="This cross-reference builds four indexes, two for finding all patients"
S PXXR("DESCR",2)="with a particular immunization and two for finding all the immunizations a"
S PXXR("DESCR",3)="patient has. "
S PXXR("DESCR",4)="The indexes are stored in the Clinical Reminders index global as:"
S PXXR("DESCR",5)="^PXRMINDX(9000010.11,""IP"",IMMUNIZATION,DFN,DATE,DAS)"
S PXXR("DESCR",6)="^PXRMINDX(9000010.11,""CVX"",""IP"",CVX CODE,DFN,DATE,DAS) "
S PXXR("DESCR",7)="and"
S PXXR("DESCR",8)="^PXRMINDX(9000010.11,""PI"",DFN,IMMUNIZATION,DATE,DAS) "
S PXXR("DESCR",9)="^PXRMINDX(9000010.11,""CVX"",""PI"",DFN,CVX CODE,DATE,DAS) "
S PXXR("DESCR",10)="respectively. "
S PXXR("DESCR",11)="For all the details, see the Clinical Reminders Index Technical"
S PXXR("DESCR",12)="Guide/Programmer's Manual."
S PXXR("SET")="D SVFILE^PXPXRM(9000010.11,.X,.DA)"
S PXXR("KILL")="D KVFILE^PXPXRM(9000010.11,.X,.DA)"
S PXXR("WHOLE KILL")="K ^PXRMINDX(9000010.11)"
S PXXR("VAL",1)=.01
S PXXR("VAL",1,"SUBSCRIPT")=1
S PXXR("VAL",1,"COLLATION")="F"
S PXXR("VAL",2)=.02
S PXXR("VAL",2,"SUBSCRIPT")=2
S PXXR("VAL",2,"COLLATION")="F"
S PXXR("VAL",3)=.03
S PXXR("VAL",3,"SUBSCRIPT")=3
S PXXR("VAL",3,"COLLATION")="F"
S PXXR("VAL",4)=1201
S PXXR("VAL",4,"COLLATION")="F"
D CREIXN^DDMOD(.PXXR,"k",.PXRES,,"PXERR")
I $G(PXRES) D
. D MES("Cross-reference "_$P(PXRES,U,2)_" (#"_$P(PXRES,U,1)_") was updated successfully.")
I $G(PXRES)="" D
. D MES("*** ERROR: Failed to update cross-reference. ***")
Q
;
CIMMXR ; Create ACR cross-reference on IMMUNIZATION file
N PXERR,PXXR,PXRES
;
D BMES("*** Creating ACR cross-reference on IMMUNIZATION file ***")
;
S PXXR("FILE")=9999999.14
S PXXR("NAME")="ACR"
S PXXR("TYPE")="MU"
S PXXR("USE")="A"
S PXXR("EXECUTION")="R"
S PXXR("ACTIVITY")=""
S PXXR("SHORT DESCR")="Updates Clinical Reminder's index when CVX code changes."
S PXXR("DESCR",1)="This cross-reference updates the Clinical Reminder's index on the V"
S PXXR("DESCR",2)="Immunization file when a CVX code changes for an immunization. The indexes"
S PXXR("DESCR",3)="updated are:"
S PXXR("DESCR",4)="^PXRMINDX(9000010.11,""CVX"",""IP"",CVX CODE,DFN,DATE,DAS) and"
S PXXR("DESCR",5)="^PXRMINDX(9000010.11,""CVX"",""PI"",DFN,CVX CODE,DATE,DAS)."
S PXXR("SET")="Q"
S PXXR("KILL")="D UPDCVX^PXPXRM(.DA,X1(1),X2(1))"
S PXXR("VAL",1)=.03
S PXXR("VAL",1,"COLLATION")="F"
D CREIXN^DDMOD(.PXXR,"k",.PXRES,,"PXERR")
I $G(PXRES) D
. D MES("Cross-reference "_$P(PXRES,U,2)_" (#"_$P(PXRES,U,1)_") was created successfully.")
I $G(PXRES)="" D
. D MES("*** ERROR: Failed to create cross-reference. ***")
Q
;
BLDVIMM ; Rebuild Clinical Reminder index on V Immunization file
N PXDESC,PXFILELIST,PXQDT,PXRTN,PXTASK,PXVOTH
N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL,ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI
;
D BMES("*** Task job to rebuild the Clinical Reminders index for V IMMUNIZATION ***")
;
I $D(^PXRMINDX(9000010.11,"CVX")) D Q ;ICR 4290
. D MES("The index has already been rebuilt by previous installation.")
. D MES("No need to rebuild it again.")
;
S PXQDT=$G(XPDQUES("POS1"))
I 'PXQDT S PXQDT=$$NOW^XLFDT
;
S PXRTN="BLDVIMMT^PXVP210"
S PXDESC="Clinical Reminders index rebuild for V IMMUNIZATION"
S PXVOTH("ZTDTH")=PXQDT
S PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,,.PXVOTH)
;
I $G(PXTASK)>0 D MES("Task number "_PXTASK_" queued.")
I $G(PXTASK)=-1 D Q
. D MES("*** ERROR: Task failed to queue ***")
Q
;
BLDVIMMT ; Queued entry point to rebuild index
S ZTREQ="@"
K ^PXRMINDX(9000010.11,"DATE BUILT") ; ICR 4114
D INDEXD^PXRMDIEV(9000010.11) ; ICR 6059
D VIMM^PXPXRMI1
Q
;
DDSEC ; Update security access codes on Immunization and Skin Test files
N PXFILENUM,PXSEC
;
D BMES("*** Updating security access codes on Immunization and Skin Test files ***")
;
S PXSEC("AUDIT")="@"
S PXSEC("DD")="@"
S PXSEC("DEL")="@"
S PXSEC("LAYGO")="@"
S PXSEC("RD")=""
S PXSEC("WR")="@"
;
F PXFILENUM=9999999.14,9999999.28 D
. D FILESEC^DDMOD(PXFILENUM,.PXSEC)
Q
;
TSKDSG ; Task job to split Dosage into Dose and Units
N PXRTN,PXDESC,PXVOTH,PXTASK
;
D BMES("*** Task job to split V Immunization DOSAGE field (#1312) ***")
I $G(^XTMP("PXVP210","DOSAGE")) D Q
. D MES("The Dosage has already been split by previous installation.")
. D MES("No need to do it again.")
;
S PXRTN="DOSAGE^PXVP210"
S PXDESC="Split V Immunization DOSAGE field (1312)"
S PXVOTH("ZTDTH")=$H
S PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,,.PXVOTH)
;
I $G(PXTASK)>0 D MES("Task number "_PXTASK_" queued.")
I $G(PXTASK)=-1 D Q
. D MES("*** ERROR: Task failed to queue ***")
Q
;
DOSAGE ; Loop through all V Immunization records and determine if Dosage needs to be split
S ZTREQ="@"
;
N PX13,PXIEN,PXVPDT
;
S PXIEN=0
F S PXIEN=$O(^AUPNVIMM(PXIEN)) Q:'PXIEN D
. S PX13=$G(^AUPNVIMM(PXIEN,13))
. I $P(PX13,U,12)'="",$P(PX13,U,13)="" D SPLITDSG(PXIEN)
;
; Set dosage flag in XTMP so that we know that the dosage split was completed
S PXVPDT=$$FMADD^XLFDT(DT,365)
S ^XTMP("PXVP210",0)=PXVPDT_"^"_DT
S ^XTMP("PXVP210","DOSAGE")=1
Q
;
SPLITDSG(PXIEN) ; Split Dosage field
N PXFILE,PXIENS,PXDOSAGE,PXDOSE,PXUNITS,PXDELIM,PXFDAE,PXFDAI,PXVALID,PXCOM
;
S PXFILE=9000010.11
S PXIENS=PXIEN_","
S PXDOSAGE=$P($G(^AUPNVIMM(PXIEN,13)),U,12)
S PXDOSAGE=$$TRIM^XLFSTR(PXDOSAGE)
S (PXDOSE,PXUNITS)=""
;
S PXDELIM=" "
I PXDOSAGE[";" S PXDELIM=";"
;
S PXDOSE=$P(PXDOSAGE,PXDELIM,1)
S PXUNITS=$P(PXDOSAGE,PXDELIM,2)
;
K PXFDAE,PXFDAI
S PXFDAE(PXFILE,PXIENS,1312)=PXDOSE
S PXFDAE(PXFILE,PXIENS,1313)=PXUNITS
D VALS^DIE("","PXFDAE","PXFDAI")
S PXVALID=0
I $G(PXFDAI(PXFILE,PXIENS,1312))'="^",$G(PXFDAI(PXFILE,PXIENS,1313))'="^" S PXVALID=1
I PXVALID D FILE^DIE("K","PXFDAI")
I 'PXVALID D
. S PXCOM=$G(^AUPNVIMM(PXIEN,811))
. S PXCOM=$S(PXCOM'="":PXCOM_"; ",1:"")_"Dosage: "_$TR(PXDOSAGE,";"," ")
. K PXFDAI
. S PXFDAI(PXFILE,PXIENS,1312)="@"
. S PXFDAI(PXFILE,PXIENS,81101)=PXCOM
. D FILE^DIE("KET","PXFDAI")
Q
;
MVDIAGS ;
; move the data in the old DIAGNOSIS fields of the V SKIN TEST file
; (#9000010.12) to the new fields:
; from old fields .08, .09, .1, .11, .12, .13, .14, .15
; to new fields 801, 802, 803, 804, 805, 806, 807, 808 respectively.
;
I $$GET1^DID(9000010.12,.08,"","LABEL")'="DIAGNOSIS" Q ; Quit if DIAGNOSIS field (#.08) does not exist
N %,CNT,DA,DIK,DR,J,Q,X,Y,PXVD,PXVNOW,PXVV
D NOW^%DTC S Y=% D DD^%DT S PXVNOW=Y
K Q S Q(1)=" ",Q(2)="*** Moving V SKIN TEST file DIAGNOSIS data to new fields."
S Q(3)=" Process started "_PXVNOW_" ***"
D BMES^XPDUTL(.Q)
S (CNT,PXVV)=0
F S PXVV=$O(^AUPNVSK(PXVV)) Q:'PXVV S PXVD=$P($G(^(PXVV,0)),"^",8,15) I PXVD'="",PXVD'="^^^^^^^" D
. S:'$D(^AUPNVSK(PXVV,80)) ^AUPNVSK(PXVV,80)=PXVD,CNT=CNT+1
. F J=8:1:15 S $P(^AUPNVSK(PXVV,0),"^",J)="" ; set diagnosis field values to null
;
MVDONE ; DIAGNOSIS data move completed
D NOW^%DTC S Y=% D DD^%DT S PXVNOW=Y
K Q S Q(1)=" ",Q(3)=" "_CNT_" entr"_$S(CNT'=1:"ies",1:"y")_" processed."
S Q(2)="*** Process moving DIAGNOSIS data completed at "_PXVNOW_" ***"
D BMES^XPDUTL(.Q)
;
RMVFLD ; remove DDs for old diagnosis fields .08 to .15
N PXF,PXJ,PXN S PXJ=1
S PXF="DIAGNOSIS",PXN=.08 D DELFLD
F PXN=.09:.01:.15 S PXJ=PXJ+1,PXF="DIAGNOSIS "_PXJ D DELFLD
Q
DELFLD ; delete field if it exists
I $$GET1^DID(9000010.12,PXN,"","LABEL")=PXF D
. D BMES^XPDUTL("*** Deleting field "_PXN_" ***")
. K DIK,DA S DIK="^DD(9000010.12,",DA=PXN,DA(1)=9000010.12 D ^DIK
Q
;
DELSCRN ; Delete screen nodes from V Immunization .01 DD
D BMES("*** Deleting screen nodes from V Immunization .01 DD ***")
K ^DD(9000010.11,.01,12) ;ICR 6256
K ^DD(9000010.11,.01,12.1) ;ICR 6256
Q
;
BMES(STR) ;
; Write string
D BMES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," "))
Q
MES(STR) ;
; Write string
D MES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," "))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVP210 10445 printed Dec 13, 2024@02:31:50 Page 2
PXVP210 ;BPOIFO/LMT - PX*1*210 KIDS Routine ;11/03/15 16:47
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**210**;Aug 12, 1996;Build 21
+2 ;
+3 ; Reference to ^PXRMINDX(9000010.11) supported by ICR #4290 and #4114
+4 ; Reference to INDEXD^PXRMDIEV supported by ICR #6059
+5 ; Reference to ^DD(9000010.11,.01,12) and ^DD(9000010.11,.01,12.1) supported by ICR #6256
+6 ;
+7 QUIT
+8 ;
PRE ; pre-install entry for patch PX*1*210
+1 NEW DIK,DA
+2 ;
+3 ; delete AC, AHR1 and AHR2 x-refs from V IMMUNIZATION file if they exist
+4 ; AC
KILL DIK,DA
SET DIK="^DD(9000010.11,.01,1,"
SET DA=4
SET DA(1)=.01
SET DA(2)=9000010.11
DO ^DIK
+5 ; AHR1
KILL DIK,DA
SET DIK="^DD(9000010.11,1201,1,"
SET DA=2
SET DA(1)=1201
SET DA(2)=9000010.11
DO ^DIK
+6 ; AHR2
KILL DIK,DA
SET DIK="^DD(9000010.11,1403,1,"
SET DA=2
SET DA(1)=1403
SET DA(2)=9000010.11
DO ^DIK
+7 ; delete AC, AHR1 and AHR2 x-refs from V SKIN TEST file if they exist
+8 ; AC
KILL DIK,DA
SET DIK="^DD(9000010.12,.01,1,"
SET DA=4
SET DA(1)=.01
SET DA(2)=9000010.12
DO ^DIK
+9 ; AHR2
KILL DIK,DA
SET DIK="^DD(9000010.12,.06,1,"
SET DA=2
SET DA(1)=.06
SET DA(2)=9000010.12
DO ^DIK
+10 ; AHR1
KILL DIK,DA
SET DIK="^DD(9000010.12,1201,1,"
SET DA=2
SET DA(1)=1201
SET DA(2)=9000010.12
DO ^DIK
+11 ; delete AU, AU1 and AU2 x-refs from IMMUNIZATION LOT file if they exist
+12 ; AU
KILL DIK,DA
SET DIK="^DD(9999999.41,.01,1,"
SET DA=2
SET DA(1)=.01
SET DA(2)=9999999.41
DO ^DIK
+13 ; AU1
KILL DIK,DA
SET DIK="^DD(9999999.41,.02,1,"
SET DA=1
SET DA(1)=.02
SET DA(2)=9999999.41
DO ^DIK
+14 ; AU2
KILL DIK,DA
SET DIK="^DD(9999999.41,.04,1,"
SET DA=2
SET DA(1)=.04
SET DA(2)=9999999.41
DO ^DIK
+15 QUIT
+16 ;
POST ; KIDS Post install for PX*1*210
+1 DO BMES("*** Post install started ***")
+2 ;
+3 ; Update ACR cross-reference on V IMMUNIZATION file
DO CVIMMXR
+4 ; Create ACR cross-reference on IMMUNIZATION file
DO CIMMXR
+5 ; Rebuild Clinical Reminder index on V Immunization file
DO BLDVIMM
+6 ; Update DD security on Immunization and Skin Test files
DO DDSEC
+7 ; Task job to split Dosage into Dose and Units
DO TSKDSG
+8 ; Move diagnosis data from old fields to new fields
DO MVDIAGS
+9 ; Delete screen nodes from V Immunization .01 DD
DO DELSCRN
+10 ;
+11 DO BMES("*** Post install completed ***")
+12 QUIT
+13 ;
CVIMMXR ; Update ACR cross-reference on V IMMUNIZATION file
+1 NEW PXERR,PXXR,PXRES
+2 ;
+3 DO BMES("*** Updating ACR cross-reference on V IMMUNIZATION file ***")
+4 ;
+5 SET PXXR("FILE")=9000010.11
+6 SET PXXR("NAME")="ACR"
+7 SET PXXR("TYPE")="MU"
+8 SET PXXR("USE")="A"
+9 SET PXXR("EXECUTION")="R"
+10 SET PXXR("ACTIVITY")="IR"
+11 SET PXXR("SHORT DESCR")="Clinical Reminders index."
+12 SET PXXR("DESCR",1)="This cross-reference builds four indexes, two for finding all patients"
+13 SET PXXR("DESCR",2)="with a particular immunization and two for finding all the immunizations a"
+14 SET PXXR("DESCR",3)="patient has. "
+15 SET PXXR("DESCR",4)="The indexes are stored in the Clinical Reminders index global as:"
+16 SET PXXR("DESCR",5)="^PXRMINDX(9000010.11,""IP"",IMMUNIZATION,DFN,DATE,DAS)"
+17 SET PXXR("DESCR",6)="^PXRMINDX(9000010.11,""CVX"",""IP"",CVX CODE,DFN,DATE,DAS) "
+18 SET PXXR("DESCR",7)="and"
+19 SET PXXR("DESCR",8)="^PXRMINDX(9000010.11,""PI"",DFN,IMMUNIZATION,DATE,DAS) "
+20 SET PXXR("DESCR",9)="^PXRMINDX(9000010.11,""CVX"",""PI"",DFN,CVX CODE,DATE,DAS) "
+21 SET PXXR("DESCR",10)="respectively. "
+22 SET PXXR("DESCR",11)="For all the details, see the Clinical Reminders Index Technical"
+23 SET PXXR("DESCR",12)="Guide/Programmer's Manual."
+24 SET PXXR("SET")="D SVFILE^PXPXRM(9000010.11,.X,.DA)"
+25 SET PXXR("KILL")="D KVFILE^PXPXRM(9000010.11,.X,.DA)"
+26 SET PXXR("WHOLE KILL")="K ^PXRMINDX(9000010.11)"
+27 SET PXXR("VAL",1)=.01
+28 SET PXXR("VAL",1,"SUBSCRIPT")=1
+29 SET PXXR("VAL",1,"COLLATION")="F"
+30 SET PXXR("VAL",2)=.02
+31 SET PXXR("VAL",2,"SUBSCRIPT")=2
+32 SET PXXR("VAL",2,"COLLATION")="F"
+33 SET PXXR("VAL",3)=.03
+34 SET PXXR("VAL",3,"SUBSCRIPT")=3
+35 SET PXXR("VAL",3,"COLLATION")="F"
+36 SET PXXR("VAL",4)=1201
+37 SET PXXR("VAL",4,"COLLATION")="F"
+38 DO CREIXN^DDMOD(.PXXR,"k",.PXRES,,"PXERR")
+39 IF $GET(PXRES)
Begin DoDot:1
+40 DO MES("Cross-reference "_$PIECE(PXRES,U,2)_" (#"_$PIECE(PXRES,U,1)_") was updated successfully.")
End DoDot:1
+41 IF $GET(PXRES)=""
Begin DoDot:1
+42 DO MES("*** ERROR: Failed to update cross-reference. ***")
End DoDot:1
+43 QUIT
+44 ;
CIMMXR ; Create ACR cross-reference on IMMUNIZATION file
+1 NEW PXERR,PXXR,PXRES
+2 ;
+3 DO BMES("*** Creating ACR cross-reference on IMMUNIZATION file ***")
+4 ;
+5 SET PXXR("FILE")=9999999.14
+6 SET PXXR("NAME")="ACR"
+7 SET PXXR("TYPE")="MU"
+8 SET PXXR("USE")="A"
+9 SET PXXR("EXECUTION")="R"
+10 SET PXXR("ACTIVITY")=""
+11 SET PXXR("SHORT DESCR")="Updates Clinical Reminder's index when CVX code changes."
+12 SET PXXR("DESCR",1)="This cross-reference updates the Clinical Reminder's index on the V"
+13 SET PXXR("DESCR",2)="Immunization file when a CVX code changes for an immunization. The indexes"
+14 SET PXXR("DESCR",3)="updated are:"
+15 SET PXXR("DESCR",4)="^PXRMINDX(9000010.11,""CVX"",""IP"",CVX CODE,DFN,DATE,DAS) and"
+16 SET PXXR("DESCR",5)="^PXRMINDX(9000010.11,""CVX"",""PI"",DFN,CVX CODE,DATE,DAS)."
+17 SET PXXR("SET")="Q"
+18 SET PXXR("KILL")="D UPDCVX^PXPXRM(.DA,X1(1),X2(1))"
+19 SET PXXR("VAL",1)=.03
+20 SET PXXR("VAL",1,"COLLATION")="F"
+21 DO CREIXN^DDMOD(.PXXR,"k",.PXRES,,"PXERR")
+22 IF $GET(PXRES)
Begin DoDot:1
+23 DO MES("Cross-reference "_$PIECE(PXRES,U,2)_" (#"_$PIECE(PXRES,U,1)_") was created successfully.")
End DoDot:1
+24 IF $GET(PXRES)=""
Begin DoDot:1
+25 DO MES("*** ERROR: Failed to create cross-reference. ***")
End DoDot:1
+26 QUIT
+27 ;
BLDVIMM ; Rebuild Clinical Reminder index on V Immunization file
+1 NEW PXDESC,PXFILELIST,PXQDT,PXRTN,PXTASK,PXVOTH
+2 NEW ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL,ZTPRI,ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI
+3 ;
+4 DO BMES("*** Task job to rebuild the Clinical Reminders index for V IMMUNIZATION ***")
+5 ;
+6 ;ICR 4290
IF $DATA(^PXRMINDX(9000010.11,"CVX"))
Begin DoDot:1
+7 DO MES("The index has already been rebuilt by previous installation.")
+8 DO MES("No need to rebuild it again.")
End DoDot:1
QUIT
+9 ;
+10 SET PXQDT=$GET(XPDQUES("POS1"))
+11 IF 'PXQDT
SET PXQDT=$$NOW^XLFDT
+12 ;
+13 SET PXRTN="BLDVIMMT^PXVP210"
+14 SET PXDESC="Clinical Reminders index rebuild for V IMMUNIZATION"
+15 SET PXVOTH("ZTDTH")=PXQDT
+16 SET PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,,.PXVOTH)
+17 ;
+18 IF $GET(PXTASK)>0
DO MES("Task number "_PXTASK_" queued.")
+19 IF $GET(PXTASK)=-1
Begin DoDot:1
+20 DO MES("*** ERROR: Task failed to queue ***")
End DoDot:1
QUIT
+21 QUIT
+22 ;
BLDVIMMT ; Queued entry point to rebuild index
+1 SET ZTREQ="@"
+2 ; ICR 4114
KILL ^PXRMINDX(9000010.11,"DATE BUILT")
+3 ; ICR 6059
DO INDEXD^PXRMDIEV(9000010.11)
+4 DO VIMM^PXPXRMI1
+5 QUIT
+6 ;
DDSEC ; Update security access codes on Immunization and Skin Test files
+1 NEW PXFILENUM,PXSEC
+2 ;
+3 DO BMES("*** Updating security access codes on Immunization and Skin Test files ***")
+4 ;
+5 SET PXSEC("AUDIT")="@"
+6 SET PXSEC("DD")="@"
+7 SET PXSEC("DEL")="@"
+8 SET PXSEC("LAYGO")="@"
+9 SET PXSEC("RD")=""
+10 SET PXSEC("WR")="@"
+11 ;
+12 FOR PXFILENUM=9999999.14,9999999.28
Begin DoDot:1
+13 DO FILESEC^DDMOD(PXFILENUM,.PXSEC)
End DoDot:1
+14 QUIT
+15 ;
TSKDSG ; Task job to split Dosage into Dose and Units
+1 NEW PXRTN,PXDESC,PXVOTH,PXTASK
+2 ;
+3 DO BMES("*** Task job to split V Immunization DOSAGE field (#1312) ***")
+4 IF $GET(^XTMP("PXVP210","DOSAGE"))
Begin DoDot:1
+5 DO MES("The Dosage has already been split by previous installation.")
+6 DO MES("No need to do it again.")
End DoDot:1
QUIT
+7 ;
+8 SET PXRTN="DOSAGE^PXVP210"
+9 SET PXDESC="Split V Immunization DOSAGE field (1312)"
+10 SET PXVOTH("ZTDTH")=$HOROLOG
+11 SET PXTASK=$$NODEV^XUTMDEVQ(PXRTN,PXDESC,,.PXVOTH)
+12 ;
+13 IF $GET(PXTASK)>0
DO MES("Task number "_PXTASK_" queued.")
+14 IF $GET(PXTASK)=-1
Begin DoDot:1
+15 DO MES("*** ERROR: Task failed to queue ***")
End DoDot:1
QUIT
+16 QUIT
+17 ;
DOSAGE ; Loop through all V Immunization records and determine if Dosage needs to be split
+1 SET ZTREQ="@"
+2 ;
+3 NEW PX13,PXIEN,PXVPDT
+4 ;
+5 SET PXIEN=0
+6 FOR
SET PXIEN=$ORDER(^AUPNVIMM(PXIEN))
if 'PXIEN
QUIT
Begin DoDot:1
+7 SET PX13=$GET(^AUPNVIMM(PXIEN,13))
+8 IF $PIECE(PX13,U,12)'=""
IF $PIECE(PX13,U,13)=""
DO SPLITDSG(PXIEN)
End DoDot:1
+9 ;
+10 ; Set dosage flag in XTMP so that we know that the dosage split was completed
+11 SET PXVPDT=$$FMADD^XLFDT(DT,365)
+12 SET ^XTMP("PXVP210",0)=PXVPDT_"^"_DT
+13 SET ^XTMP("PXVP210","DOSAGE")=1
+14 QUIT
+15 ;
SPLITDSG(PXIEN) ; Split Dosage field
+1 NEW PXFILE,PXIENS,PXDOSAGE,PXDOSE,PXUNITS,PXDELIM,PXFDAE,PXFDAI,PXVALID,PXCOM
+2 ;
+3 SET PXFILE=9000010.11
+4 SET PXIENS=PXIEN_","
+5 SET PXDOSAGE=$PIECE($GET(^AUPNVIMM(PXIEN,13)),U,12)
+6 SET PXDOSAGE=$$TRIM^XLFSTR(PXDOSAGE)
+7 SET (PXDOSE,PXUNITS)=""
+8 ;
+9 SET PXDELIM=" "
+10 IF PXDOSAGE[";"
SET PXDELIM=";"
+11 ;
+12 SET PXDOSE=$PIECE(PXDOSAGE,PXDELIM,1)
+13 SET PXUNITS=$PIECE(PXDOSAGE,PXDELIM,2)
+14 ;
+15 KILL PXFDAE,PXFDAI
+16 SET PXFDAE(PXFILE,PXIENS,1312)=PXDOSE
+17 SET PXFDAE(PXFILE,PXIENS,1313)=PXUNITS
+18 DO VALS^DIE("","PXFDAE","PXFDAI")
+19 SET PXVALID=0
+20 IF $GET(PXFDAI(PXFILE,PXIENS,1312))'="^"
IF $GET(PXFDAI(PXFILE,PXIENS,1313))'="^"
SET PXVALID=1
+21 IF PXVALID
DO FILE^DIE("K","PXFDAI")
+22 IF 'PXVALID
Begin DoDot:1
+23 SET PXCOM=$GET(^AUPNVIMM(PXIEN,811))
+24 SET PXCOM=$SELECT(PXCOM'="":PXCOM_"; ",1:"")_"Dosage: "_$TRANSLATE(PXDOSAGE,";"," ")
+25 KILL PXFDAI
+26 SET PXFDAI(PXFILE,PXIENS,1312)="@"
+27 SET PXFDAI(PXFILE,PXIENS,81101)=PXCOM
+28 DO FILE^DIE("KET","PXFDAI")
End DoDot:1
+29 QUIT
+30 ;
MVDIAGS ;
+1 ; move the data in the old DIAGNOSIS fields of the V SKIN TEST file
+2 ; (#9000010.12) to the new fields:
+3 ; from old fields .08, .09, .1, .11, .12, .13, .14, .15
+4 ; to new fields 801, 802, 803, 804, 805, 806, 807, 808 respectively.
+5 ;
+6 ; Quit if DIAGNOSIS field (#.08) does not exist
IF $$GET1^DID(9000010.12,.08,"","LABEL")'="DIAGNOSIS"
QUIT
+7 NEW %,CNT,DA,DIK,DR,J,Q,X,Y,PXVD,PXVNOW,PXVV
+8 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PXVNOW=Y
+9 KILL Q
SET Q(1)=" "
SET Q(2)="*** Moving V SKIN TEST file DIAGNOSIS data to new fields."
+10 SET Q(3)=" Process started "_PXVNOW_" ***"
+11 DO BMES^XPDUTL(.Q)
+12 SET (CNT,PXVV)=0
+13 FOR
SET PXVV=$ORDER(^AUPNVSK(PXVV))
if 'PXVV
QUIT
SET PXVD=$PIECE($GET(^(PXVV,0)),"^",8,15)
IF PXVD'=""
IF PXVD'="^^^^^^^"
Begin DoDot:1
+14 if '$DATA(^AUPNVSK(PXVV,80))
SET ^AUPNVSK(PXVV,80)=PXVD
SET CNT=CNT+1
+15 ; set diagnosis field values to null
FOR J=8:1:15
SET $PIECE(^AUPNVSK(PXVV,0),"^",J)=""
End DoDot:1
+16 ;
MVDONE ; DIAGNOSIS data move completed
+1 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PXVNOW=Y
+2 KILL Q
SET Q(1)=" "
SET Q(3)=" "_CNT_" entr"_$SELECT(CNT'=1:"ies",1:"y")_" processed."
+3 SET Q(2)="*** Process moving DIAGNOSIS data completed at "_PXVNOW_" ***"
+4 DO BMES^XPDUTL(.Q)
+5 ;
RMVFLD ; remove DDs for old diagnosis fields .08 to .15
+1 NEW PXF,PXJ,PXN
SET PXJ=1
+2 SET PXF="DIAGNOSIS"
SET PXN=.08
DO DELFLD
+3 FOR PXN=.09:.01:.15
SET PXJ=PXJ+1
SET PXF="DIAGNOSIS "_PXJ
DO DELFLD
+4 QUIT
DELFLD ; delete field if it exists
+1 IF $$GET1^DID(9000010.12,PXN,"","LABEL")=PXF
Begin DoDot:1
+2 DO BMES^XPDUTL("*** Deleting field "_PXN_" ***")
+3 KILL DIK,DA
SET DIK="^DD(9000010.12,"
SET DA=PXN
SET DA(1)=9000010.12
DO ^DIK
End DoDot:1
+4 QUIT
+5 ;
DELSCRN ; Delete screen nodes from V Immunization .01 DD
+1 DO BMES("*** Deleting screen nodes from V Immunization .01 DD ***")
+2 ;ICR 6256
KILL ^DD(9000010.11,.01,12)
+3 ;ICR 6256
KILL ^DD(9000010.11,.01,12.1)
+4 QUIT
+5 ;
BMES(STR) ;
+1 ; Write string
+2 DO BMES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$GET(IOM,80)),"R"," "))
+3 QUIT
MES(STR) ;
+1 ; Write string
+2 DO MES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$GET(IOM,80)),"R"," "))
+3 QUIT
