- 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 Feb 18, 2025@23:52:09 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
