PXAIIMM ;ISL/PKR - Set the IMMUNIZATION nodes. ;Oct 29, 2021@10:12:47
;;1.0;PCE PATIENT CARE ENCOUNTER;**45,124,209,210,215,211,217**;Aug 12, 1996;Build 134
;
IMM ;Main entry point.
;
K PXAERR
S PXAERR(8)=PXAK
S PXAERR(7)="IMMUNIZATION"
;
N IND,PXAA
S IND=""
F S IND=$O(@PXADATA@("IMMUNIZATION",PXAK,IND)) Q:IND="" D
. I IND?1(1"VIS",1"REMARKS") D Q
. . M PXAA(IND)=@PXADATA@("IMMUNIZATION",PXAK,IND)
. S PXAA(IND)=@PXADATA@("IMMUNIZATION",PXAK,IND)
;
;Validate the data.
N STOP
D VAL^PXAIIMMV
I $G(STOP) Q
;
SETVARA ;Set the after visit variables.
N AFTER0,AFTER12,AFTER13,AFTER14,AFTER15,AFTER16,AFTER811,AFTER812
S $P(AFTER0,U,1)=$G(PXAA("IMMUN"))
I $G(PXAA("DELETE")) S $P(AFTER0,U,1)="@"
S $P(AFTER0,U,2)=$G(PATIENT)
S $P(AFTER0,U,3)=$G(PXAVISIT)
S $P(AFTER0,U,4)=$G(PXAA("SERIES"))
S $P(AFTER0,U,6)=$G(PXAA("REACTION"))
S $P(AFTER0,U,7)=$G(PXAA("CONTRAINDICATED"))
S $P(AFTER12,U,1)=$G(PXAA("EVENT D/T"))
S $P(AFTER12,U,4)=$G(PXAA("ENC PROVIDER"))
S $P(AFTER811,U,1)=$G(PXAA("COMMENT"))
;
;--PACKAGE AND SOURCE
S $P(AFTER812,"^",2)=$S($G(PXAA("PKG"))'="":PXAA("PKG"),1:$G(PXAPKG))
S $P(AFTER812,"^",3)=$S($G(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$G(PXASOURC))
;
;--Add new fields for VIMM 2.0 - PX*1*209/210/215
S $P(AFTER12,U,2)=$G(PXAA("ORD PROVIDER"))
S $P(AFTER12,U,7)=$G(PXAA("LOT NUM"))
S $P(AFTER12,U,20)=$G(PXAA("WARNING ACK"))
S $P(AFTER12,U,22)=$G(PXAA("ORD BY POLICY"))
S $P(AFTER13,U)=$G(PXAA("INFO SOURCE"))
S $P(AFTER13,U,2)=$G(PXAA("ADMIN ROUTE"))
S $P(AFTER13,U,3)=$G(PXAA("ANATOMIC LOC"))
;Do not store diagnosis as of PX*1*211
;S $P(AFTER13,U,4)=$G(PXAA("DIAGNOSIS"))
S $P(AFTER13,U,12)=$G(PXAA("DOSE"))
S $P(AFTER13,U,13)=$G(PXAA("DOSE UNITS"))
;
; Reading fields (for smallpox)
S $P(AFTER14,U,1)=$G(PXAA("RESULT"))
S $P(AFTER14,U,2)=$G(PXAA("READING"))
S $P(AFTER14,U,3)=$G(PXAA("D/T READ"))
S $P(AFTER14,U,4)=$G(PXAA("READER"))
S $P(AFTER15,U,1)=$G(PXAA("READING COMMENT"))
;
S $P(AFTER16,U,1)=$G(PXAA("OVERRIDE REASON"))
;
S ^TMP("PXK",$J,"IMM",PXAK,0,"AFTER")=AFTER0
S ^TMP("PXK",$J,"IMM",PXAK,12,"AFTER")=AFTER12
S ^TMP("PXK",$J,"IMM",PXAK,13,"AFTER")=AFTER13
S ^TMP("PXK",$J,"IMM",PXAK,14,"AFTER")=AFTER14
S ^TMP("PXK",$J,"IMM",PXAK,15,"AFTER")=AFTER15
S ^TMP("PXK",$J,"IMM",PXAK,16,"AFTER")=AFTER16
S ^TMP("PXK",$J,"IMM",PXAK,811,"AFTER")=AFTER811
S ^TMP("PXK",$J,"IMM",PXAK,812,"AFTER")=AFTER812
;
; Add multiple data to PXK AFTER - PX*1*210
N FLD,SEQ,SUB
;
F FLD="VIS","REMARKS" D
. ;
. S SUB=$S(FLD="VIS":2,1:11)
. ;
. ; Delete multiple
. I $G(PXAA(FLD))="@" D Q
. . S ^TMP("PXK",$J,"IMM",PXAK,SUB,0,"AFTER")="@"
. ;
. S SEQ=0
. F S SEQ=$O(PXAA(FLD,SEQ)) Q:'SEQ D
. . S ^TMP("PXK",$J,"IMM",PXAK,SUB,SEQ,"AFTER")=$G(PXAA(FLD,SEQ,0))
;
; Add DIAGNOSIS 2 thru 8 to OTHER DIAGNOSIS multiple
;Do not store diagnosis as of PX*1*211
;N DIAGNUM,DIAGSTR
;S SEQ=0
;F DIAGNUM=2:1:8 D
;. S DIAGSTR="DIAGNOSIS "_DIAGNUM
;. I $G(PXAA(DIAGSTR))'="" D
;. . S SEQ=SEQ+1
;. . S ^TMP("PXK",$J,"IMM",PXAK,3,SEQ,"AFTER")=PXAA(DIAGSTR)
;
SETVARB ;Set the before variables.
N BEFOR0,BEFOR12,BEFOR13,BEFOR14,BEFOR15,BEFOR16,BEFOR811,BEFOR812
N IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM
D IMM^PXBGIMM(PXAVISIT)
;
S IENB=""
I PXBCNT>0 D
. S PXAAX("IMMUN")=$P($G(^AUTTIMM(PXAA("IMMUN"),0)),U,1)
. S IENB=$O(PXBKY(PXAAX("IMMUN"),IENB))
I $G(IENB) D
. S BEFOR0=$G(^AUPNVIMM(IENB,0))
. S BEFOR12=$G(^AUPNVIMM(IENB,12))
. S BEFOR13=$G(^AUPNVIMM(IENB,13))
. S BEFOR14=$G(^AUPNVIMM(IENB,14))
. S BEFOR15=$G(^AUPNVIMM(IENB,15))
. S BEFOR16=$G(^AUPNVIMM(IENB,16))
. S BEFOR811=$G(^AUPNVIMM(IENB,811))
. S BEFOR812=$G(^AUPNVIMM(IENB,812))
E S (BEFOR0,BEFOR11,BEFOR12,BEFOR13,BEFOR14,BEFOR15,BEFOR16,BEFOR811,BEFOR812)=""
;
S ^TMP("PXK",$J,"IMM",PXAK,0,"BEFORE")=BEFOR0
S ^TMP("PXK",$J,"IMM",PXAK,12,"BEFORE")=BEFOR12
S ^TMP("PXK",$J,"IMM",PXAK,13,"BEFORE")=BEFOR13
S ^TMP("PXK",$J,"IMM",PXAK,14,"BEFORE")=BEFOR14
S ^TMP("PXK",$J,"IMM",PXAK,15,"BEFORE")=BEFOR15
S ^TMP("PXK",$J,"IMM",PXAK,16,"BEFORE")=BEFOR16
S ^TMP("PXK",$J,"IMM",PXAK,811,"BEFORE")=BEFOR811
S ^TMP("PXK",$J,"IMM",PXAK,812,"BEFORE")=BEFOR812
S ^TMP("PXK",$J,"IMM",PXAK,"IEN")=IENB
;
;Package and Data Source cannot be edited.
S BEFOR812=^TMP("PXK",$J,"IMM",PXAK,812,"BEFORE")
I BEFOR812'="" D
. I AFTER812=BEFOR812 Q
. I $P(BEFOR812,U,2)'="" S $P(AFTER812,U,2)=$P(BEFOR812,U,2)
. I $P(BEFOR812,U,3)'="" S $P(AFTER812,U,3)=$P(BEFOR812,U,3)
. S ^TMP("PXK",$J,"IMM",PXAK,812,"AFTER")=AFTER812
;
; Add multiple data to PXK BEFORE
I $G(IENB) D
. N IENSUB,SUB
. F SUB=2,3,11 D
. . S IENSUB=0
. . F S IENSUB=$O(^AUPNVIMM(IENB,SUB,IENSUB)) Q:'IENSUB D
. . . S ^TMP("PXK",$J,"IMM",PXAK,SUB,IENSUB,"BEFORE")=$G(^AUPNVIMM(IENB,SUB,IENSUB,0))
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIIMM 4883 printed Dec 13, 2024@02:25:51 Page 2
PXAIIMM ;ISL/PKR - Set the IMMUNIZATION nodes. ;Oct 29, 2021@10:12:47
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**45,124,209,210,215,211,217**;Aug 12, 1996;Build 134
+2 ;
IMM ;Main entry point.
+1 ;
+2 KILL PXAERR
+3 SET PXAERR(8)=PXAK
+4 SET PXAERR(7)="IMMUNIZATION"
+5 ;
+6 NEW IND,PXAA
+7 SET IND=""
+8 FOR
SET IND=$ORDER(@PXADATA@("IMMUNIZATION",PXAK,IND))
if IND=""
QUIT
Begin DoDot:1
+9 IF IND?1(1"VIS",1"REMARKS")
Begin DoDot:2
+10 MERGE PXAA(IND)=@PXADATA@("IMMUNIZATION",PXAK,IND)
End DoDot:2
QUIT
+11 SET PXAA(IND)=@PXADATA@("IMMUNIZATION",PXAK,IND)
End DoDot:1
+12 ;
+13 ;Validate the data.
+14 NEW STOP
+15 DO VAL^PXAIIMMV
+16 IF $GET(STOP)
QUIT
+17 ;
SETVARA ;Set the after visit variables.
+1 NEW AFTER0,AFTER12,AFTER13,AFTER14,AFTER15,AFTER16,AFTER811,AFTER812
+2 SET $PIECE(AFTER0,U,1)=$GET(PXAA("IMMUN"))
+3 IF $GET(PXAA("DELETE"))
SET $PIECE(AFTER0,U,1)="@"
+4 SET $PIECE(AFTER0,U,2)=$GET(PATIENT)
+5 SET $PIECE(AFTER0,U,3)=$GET(PXAVISIT)
+6 SET $PIECE(AFTER0,U,4)=$GET(PXAA("SERIES"))
+7 SET $PIECE(AFTER0,U,6)=$GET(PXAA("REACTION"))
+8 SET $PIECE(AFTER0,U,7)=$GET(PXAA("CONTRAINDICATED"))
+9 SET $PIECE(AFTER12,U,1)=$GET(PXAA("EVENT D/T"))
+10 SET $PIECE(AFTER12,U,4)=$GET(PXAA("ENC PROVIDER"))
+11 SET $PIECE(AFTER811,U,1)=$GET(PXAA("COMMENT"))
+12 ;
+13 ;--PACKAGE AND SOURCE
+14 SET $PIECE(AFTER812,"^",2)=$SELECT($GET(PXAA("PKG"))'="":PXAA("PKG"),1:$GET(PXAPKG))
+15 SET $PIECE(AFTER812,"^",3)=$SELECT($GET(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$GET(PXASOURC))
+16 ;
+17 ;--Add new fields for VIMM 2.0 - PX*1*209/210/215
+18 SET $PIECE(AFTER12,U,2)=$GET(PXAA("ORD PROVIDER"))
+19 SET $PIECE(AFTER12,U,7)=$GET(PXAA("LOT NUM"))
+20 SET $PIECE(AFTER12,U,20)=$GET(PXAA("WARNING ACK"))
+21 SET $PIECE(AFTER12,U,22)=$GET(PXAA("ORD BY POLICY"))
+22 SET $PIECE(AFTER13,U)=$GET(PXAA("INFO SOURCE"))
+23 SET $PIECE(AFTER13,U,2)=$GET(PXAA("ADMIN ROUTE"))
+24 SET $PIECE(AFTER13,U,3)=$GET(PXAA("ANATOMIC LOC"))
+25 ;Do not store diagnosis as of PX*1*211
+26 ;S $P(AFTER13,U,4)=$G(PXAA("DIAGNOSIS"))
+27 SET $PIECE(AFTER13,U,12)=$GET(PXAA("DOSE"))
+28 SET $PIECE(AFTER13,U,13)=$GET(PXAA("DOSE UNITS"))
+29 ;
+30 ; Reading fields (for smallpox)
+31 SET $PIECE(AFTER14,U,1)=$GET(PXAA("RESULT"))
+32 SET $PIECE(AFTER14,U,2)=$GET(PXAA("READING"))
+33 SET $PIECE(AFTER14,U,3)=$GET(PXAA("D/T READ"))
+34 SET $PIECE(AFTER14,U,4)=$GET(PXAA("READER"))
+35 SET $PIECE(AFTER15,U,1)=$GET(PXAA("READING COMMENT"))
+36 ;
+37 SET $PIECE(AFTER16,U,1)=$GET(PXAA("OVERRIDE REASON"))
+38 ;
+39 SET ^TMP("PXK",$JOB,"IMM",PXAK,0,"AFTER")=AFTER0
+40 SET ^TMP("PXK",$JOB,"IMM",PXAK,12,"AFTER")=AFTER12
+41 SET ^TMP("PXK",$JOB,"IMM",PXAK,13,"AFTER")=AFTER13
+42 SET ^TMP("PXK",$JOB,"IMM",PXAK,14,"AFTER")=AFTER14
+43 SET ^TMP("PXK",$JOB,"IMM",PXAK,15,"AFTER")=AFTER15
+44 SET ^TMP("PXK",$JOB,"IMM",PXAK,16,"AFTER")=AFTER16
+45 SET ^TMP("PXK",$JOB,"IMM",PXAK,811,"AFTER")=AFTER811
+46 SET ^TMP("PXK",$JOB,"IMM",PXAK,812,"AFTER")=AFTER812
+47 ;
+48 ; Add multiple data to PXK AFTER - PX*1*210
+49 NEW FLD,SEQ,SUB
+50 ;
+51 FOR FLD="VIS","REMARKS"
Begin DoDot:1
+52 ;
+53 SET SUB=$SELECT(FLD="VIS":2,1:11)
+54 ;
+55 ; Delete multiple
+56 IF $GET(PXAA(FLD))="@"
Begin DoDot:2
+57 SET ^TMP("PXK",$JOB,"IMM",PXAK,SUB,0,"AFTER")="@"
End DoDot:2
QUIT
+58 ;
+59 SET SEQ=0
+60 FOR
SET SEQ=$ORDER(PXAA(FLD,SEQ))
if 'SEQ
QUIT
Begin DoDot:2
+61 SET ^TMP("PXK",$JOB,"IMM",PXAK,SUB,SEQ,"AFTER")=$GET(PXAA(FLD,SEQ,0))
End DoDot:2
End DoDot:1
+62 ;
+63 ; Add DIAGNOSIS 2 thru 8 to OTHER DIAGNOSIS multiple
+64 ;Do not store diagnosis as of PX*1*211
+65 ;N DIAGNUM,DIAGSTR
+66 ;S SEQ=0
+67 ;F DIAGNUM=2:1:8 D
+68 ;. S DIAGSTR="DIAGNOSIS "_DIAGNUM
+69 ;. I $G(PXAA(DIAGSTR))'="" D
+70 ;. . S SEQ=SEQ+1
+71 ;. . S ^TMP("PXK",$J,"IMM",PXAK,3,SEQ,"AFTER")=PXAA(DIAGSTR)
+72 ;
SETVARB ;Set the before variables.
+1 NEW BEFOR0,BEFOR12,BEFOR13,BEFOR14,BEFOR15,BEFOR16,BEFOR811,BEFOR812
+2 NEW IENB,PXAAX,PXBCNT,PXBKY,PXBSKY,PXBSAM
+3 DO IMM^PXBGIMM(PXAVISIT)
+4 ;
+5 SET IENB=""
+6 IF PXBCNT>0
Begin DoDot:1
+7 SET PXAAX("IMMUN")=$PIECE($GET(^AUTTIMM(PXAA("IMMUN"),0)),U,1)
+8 SET IENB=$ORDER(PXBKY(PXAAX("IMMUN"),IENB))
End DoDot:1
+9 IF $GET(IENB)
Begin DoDot:1
+10 SET BEFOR0=$GET(^AUPNVIMM(IENB,0))
+11 SET BEFOR12=$GET(^AUPNVIMM(IENB,12))
+12 SET BEFOR13=$GET(^AUPNVIMM(IENB,13))
+13 SET BEFOR14=$GET(^AUPNVIMM(IENB,14))
+14 SET BEFOR15=$GET(^AUPNVIMM(IENB,15))
+15 SET BEFOR16=$GET(^AUPNVIMM(IENB,16))
+16 SET BEFOR811=$GET(^AUPNVIMM(IENB,811))
+17 SET BEFOR812=$GET(^AUPNVIMM(IENB,812))
End DoDot:1
+18 IF '$TEST
SET (BEFOR0,BEFOR11,BEFOR12,BEFOR13,BEFOR14,BEFOR15,BEFOR16,BEFOR811,BEFOR812)=""
+19 ;
+20 SET ^TMP("PXK",$JOB,"IMM",PXAK,0,"BEFORE")=BEFOR0
+21 SET ^TMP("PXK",$JOB,"IMM",PXAK,12,"BEFORE")=BEFOR12
+22 SET ^TMP("PXK",$JOB,"IMM",PXAK,13,"BEFORE")=BEFOR13
+23 SET ^TMP("PXK",$JOB,"IMM",PXAK,14,"BEFORE")=BEFOR14
+24 SET ^TMP("PXK",$JOB,"IMM",PXAK,15,"BEFORE")=BEFOR15
+25 SET ^TMP("PXK",$JOB,"IMM",PXAK,16,"BEFORE")=BEFOR16
+26 SET ^TMP("PXK",$JOB,"IMM",PXAK,811,"BEFORE")=BEFOR811
+27 SET ^TMP("PXK",$JOB,"IMM",PXAK,812,"BEFORE")=BEFOR812
+28 SET ^TMP("PXK",$JOB,"IMM",PXAK,"IEN")=IENB
+29 ;
+30 ;Package and Data Source cannot be edited.
+31 SET BEFOR812=^TMP("PXK",$JOB,"IMM",PXAK,812,"BEFORE")
+32 IF BEFOR812'=""
Begin DoDot:1
+33 IF AFTER812=BEFOR812
QUIT
+34 IF $PIECE(BEFOR812,U,2)'=""
SET $PIECE(AFTER812,U,2)=$PIECE(BEFOR812,U,2)
+35 IF $PIECE(BEFOR812,U,3)'=""
SET $PIECE(AFTER812,U,3)=$PIECE(BEFOR812,U,3)
+36 SET ^TMP("PXK",$JOB,"IMM",PXAK,812,"AFTER")=AFTER812
End DoDot:1
+37 ;
+38 ; Add multiple data to PXK BEFORE
+39 IF $GET(IENB)
Begin DoDot:1
+40 NEW IENSUB,SUB
+41 FOR SUB=2,3,11
Begin DoDot:2
+42 SET IENSUB=0
+43 FOR
SET IENSUB=$ORDER(^AUPNVIMM(IENB,SUB,IENSUB))
if 'IENSUB
QUIT
Begin DoDot:3
+44 SET ^TMP("PXK",$JOB,"IMM",PXAK,SUB,IENSUB,"BEFORE")=$GET(^AUPNVIMM(IENB,SUB,IENSUB,0))
End DoDot:3
End DoDot:2
End DoDot:1
+45 ;
+46 QUIT
