PXCAVIMM ;ISL/dee - Validates & Translates data from the PCE Device Interface into PCE's PXK format for Immunizations ;07/30/15 09:21
;;1.0;PCE PATIENT CARE ENCOUNTER;**27,124,199,210**;Aug 12, 1996;Build 21
Q
; Variables
; PXCAIMM Copy of a IMMUNIZATION node of the PXCA array
; PXCAPRV Pointer to the provider (200)
; PXCANUMB Count of the number if IMMs
; PXCAINDX Count of the number of IMMUNIZATION for one provider
; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,0,"AFTER")
; PXCAPNAR Pointer to the provider narrative (9999999.27)
;
IMM(PXCAIMM,PXCANUMB,PXCAPRV,PXCAERRS) ;
N PXCAFTER,PXDIAGPC,PXSEQ
S PXCAFTER=$P(PXCAIMM,"^",1)_"^"_PXCAPAT_"^"_PXCAVSIT_"^"
S PXCAFTER=PXCAFTER_$P(PXCAIMM,"^",2,4)
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,"IEN")=""
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,0,"BEFORE")=""
;PX*1*124
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,0,"AFTER")=PXCAFTER
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,12,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,12,"AFTER")=$P(PXCAIMM,"^",6)_"^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,13,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,13,"AFTER")="^^^"_$P(PXCAIMM,"^",8)
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,811,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,811,"AFTER")=$P(PXCAIMM,"^",7)
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,812,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
;
S PXSEQ=0
F PXDIAGPC=9:1:15 D
. I $P(PXCAIMM,"^",PXDIAGPC)'="" D
. . S PXSEQ=PXSEQ+1
. . S ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,3,PXSEQ,"AFTER")=$P(PXCAIMM,"^",PXDIAGPC)
Q
;
IMMUN(PXCA,PXCABULD,PXCAERRS) ;Validation routine for IMM
Q:'$D(PXCA("IMMUNIZATION"))
N PXCAIMM,PXCAINDX,PXCAITEM,PXCAITM2,PXCANUMB,PXCAPRV,PXDXDATE
S PXDXDATE=$S($D(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),$D(PXCADT)=1:PXCADT,1:DT)
S PXCAPRV="",PXCANUMB=0
F S PXCAPRV=$O(PXCA("IMMUNIZATION",PXCAPRV)) Q:PXCAPRV']"" D
. I PXCAPRV>0 D
.. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","IMMUNIZATION",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
.. E I PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
. S PXCAINDX=0
. F S PXCAINDX=$O(PXCA("IMMUNIZATION",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
.. S PXCAIMM=$G(PXCA("IMMUNIZATION",PXCAPRV,PXCAINDX))
.. S PXCANUMB=PXCANUMB+1
.. I PXCAIMM="" S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,0)="IMMUNIZATION data missing" Q
.. S PXCAITEM=+$P(PXCAIMM,U,1)
.. I $G(^AUTTIMM(PXCAITEM,0))="" S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,1)="IMMUNIZATION type not in file 9999999.14^"_PXCAITEM
.. S PXCAITEM=$P(PXCAIMM,U,2)
.. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="C")!(PXCAITEM="B")!((PXCAITEM=(PXCAITEM\1))&(PXCAITEM>0)&(PXCAITEM<9))) S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,2)="IMMUNIZATION series must be P|C|B|1|2|3|4|5|6|7|8^"_PXCAITEM
.. S PXCAITEM=$P(PXCAIMM,U,4)
.. I '((PXCAITEM=(PXCAITEM\1)&(PXCAITEM>0)&(PXCAITEM<12))!(PXCAITEM="")) S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,4)="IMMUNIZATION reaction must be an integer form 1 to 11^"_PXCAITEM
.. S PXCAITEM=$P(PXCAIMM,U,5)
.. I '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM="")) S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,5)="IMMUNIZATION contraindicated flag bad^"_PXCAITEM
.. S PXCAITEM=$P(PXCAIMM,U,6)
.. S PXCAITEM=$P(PXCAIMM,U,7)
.. I $L(PXCAITEM)>80 S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,6)="IMMUNIZATION remarks must be 1-80 Characters^"_PXCAITEM
.. F ICDPCE=8:1:15 D
... S PXCAITEM=$P(PXCAIMM,U,ICDPCE) I PXCAITEM]"" D
.... S ICDDATA=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
.... I $P(ICDDATA,U,1)'>0 D
..... S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,ICDPCE)="IMMUNIZATION Diagnosis # "_(ICDPCE-7)_" not in file 80^"_PXCAITEM
.... E I $P(ICDDATA,U,10)'=1 D
..... S PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,ICDPCE)="IMMUNIZATION Diagnosis # "_(ICDPCE-7)_" not an ACTIVE ICD Code^"_PXCAITEM
.. I PXCABULD&'$D(PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX))!PXCAERRS D IMM(PXCAIMM,.PXCANUMB,PXCAPRV,PXCAERRS)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCAVIMM 4066 printed Dec 13, 2024@02:27:44 Page 2
PXCAVIMM ;ISL/dee - Validates & Translates data from the PCE Device Interface into PCE's PXK format for Immunizations ;07/30/15 09:21
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,124,199,210**;Aug 12, 1996;Build 21
+2 QUIT
+3 ; Variables
+4 ; PXCAIMM Copy of a IMMUNIZATION node of the PXCA array
+5 ; PXCAPRV Pointer to the provider (200)
+6 ; PXCANUMB Count of the number if IMMs
+7 ; PXCAINDX Count of the number of IMMUNIZATION for one provider
+8 ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"IMM",PXCANUMB,0,"AFTER")
+9 ; PXCAPNAR Pointer to the provider narrative (9999999.27)
+10 ;
IMM(PXCAIMM,PXCANUMB,PXCAPRV,PXCAERRS) ;
+1 NEW PXCAFTER,PXDIAGPC,PXSEQ
+2 SET PXCAFTER=$PIECE(PXCAIMM,"^",1)_"^"_PXCAPAT_"^"_PXCAVSIT_"^"
+3 SET PXCAFTER=PXCAFTER_$PIECE(PXCAIMM,"^",2,4)
+4 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,"IEN")=""
+5 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,0,"BEFORE")=""
+6 ;PX*1*124
+7 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,0,"AFTER")=PXCAFTER
+8 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,12,"BEFORE")=""
+9 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,12,"AFTER")=$PIECE(PXCAIMM,"^",6)_"^^^"_$SELECT(PXCAPRV>0:PXCAPRV,1:"")
+10 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,13,"BEFORE")=""
+11 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,13,"AFTER")="^^^"_$PIECE(PXCAIMM,"^",8)
+12 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,811,"BEFORE")=""
+13 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,811,"AFTER")=$PIECE(PXCAIMM,"^",7)
+14 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,812,"BEFORE")=""
+15 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
+16 ;
+17 SET PXSEQ=0
+18 FOR PXDIAGPC=9:1:15
Begin DoDot:1
+19 IF $PIECE(PXCAIMM,"^",PXDIAGPC)'=""
Begin DoDot:2
+20 SET PXSEQ=PXSEQ+1
+21 SET ^TMP(PXCAGLB,$JOB,"IMM",PXCANUMB,3,PXSEQ,"AFTER")=$PIECE(PXCAIMM,"^",PXDIAGPC)
End DoDot:2
End DoDot:1
+22 QUIT
+23 ;
IMMUN(PXCA,PXCABULD,PXCAERRS) ;Validation routine for IMM
+1 if '$DATA(PXCA("IMMUNIZATION"))
QUIT
+2 NEW PXCAIMM,PXCAINDX,PXCAITEM,PXCAITM2,PXCANUMB,PXCAPRV,PXDXDATE
+3 SET PXDXDATE=$SELECT($DATA(PXCAVSIT)=1:$$CSDATE^PXDXUTL(PXCAVSIT),$DATA(PXCADT)=1:PXCADT,1:DT)
+4 SET PXCAPRV=""
SET PXCANUMB=0
+5 FOR
SET PXCAPRV=$ORDER(PXCA("IMMUNIZATION",PXCAPRV))
if PXCAPRV']""
QUIT
Begin DoDot:1
+6 IF PXCAPRV>0
Begin DoDot:2
+7 IF '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT)
SET PXCA("ERROR","IMMUNIZATION",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
+8 IF '$TEST
IF PXCABULD!PXCAERRS
DO ANOTHPRV^PXCAPRV(PXCAPRV)
End DoDot:2
+9 SET PXCAINDX=0
+10 FOR
SET PXCAINDX=$ORDER(PXCA("IMMUNIZATION",PXCAPRV,PXCAINDX))
if PXCAINDX']""
QUIT
Begin DoDot:2
+11 SET PXCAIMM=$GET(PXCA("IMMUNIZATION",PXCAPRV,PXCAINDX))
+12 SET PXCANUMB=PXCANUMB+1
+13 IF PXCAIMM=""
SET PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,0)="IMMUNIZATION data missing"
QUIT
+14 SET PXCAITEM=+$PIECE(PXCAIMM,U,1)
+15 IF $GET(^AUTTIMM(PXCAITEM,0))=""
SET PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,1)="IMMUNIZATION type not in file 9999999.14^"_PXCAITEM
+16 SET PXCAITEM=$PIECE(PXCAIMM,U,2)
+17 IF '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="C")!(PXCAITEM="B")!((PXCAITEM=(PXCAITEM\1))&(PXCAITEM>0)&(PXCAITEM<9)))
SET PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,2)="IMMUNIZATION series must be P|C|B|1|2|3|4|5|6|7|8^"_PXCAITEM
+18 SET PXCAITEM=$PIECE(PXCAIMM,U,4)
+19 IF '((PXCAITEM=(PXCAITEM\1)&(PXCAITEM>0)&(PXCAITEM<12))!(PXCAITEM=""))
SET PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,4)="IMMUNIZATION reaction must be an integer form 1 to 11^"_PXCAITEM
+20 SET PXCAITEM=$PIECE(PXCAIMM,U,5)
+21 IF '(PXCAITEM=1!(PXCAITEM=0)!(PXCAITEM=""))
SET PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,5)="IMMUNIZATION contraindicated flag bad^"_PXCAITEM
+22 SET PXCAITEM=$PIECE(PXCAIMM,U,6)
+23 SET PXCAITEM=$PIECE(PXCAIMM,U,7)
+24 IF $LENGTH(PXCAITEM)>80
SET PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,6)="IMMUNIZATION remarks must be 1-80 Characters^"_PXCAITEM
+25 FOR ICDPCE=8:1:15
Begin DoDot:3
+26 SET PXCAITEM=$PIECE(PXCAIMM,U,ICDPCE)
IF PXCAITEM]""
Begin DoDot:4
+27 SET ICDDATA=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
+28 IF $PIECE(ICDDATA,U,1)'>0
Begin DoDot:5
+29 SET PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,ICDPCE)="IMMUNIZATION Diagnosis # "_(ICDPCE-7)_" not in file 80^"_PXCAITEM
End DoDot:5
+30 IF '$TEST
IF $PIECE(ICDDATA,U,10)'=1
Begin DoDot:5
+31 SET PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX,ICDPCE)="IMMUNIZATION Diagnosis # "_(ICDPCE-7)_" not an ACTIVE ICD Code^"_PXCAITEM
End DoDot:5
End DoDot:4
End DoDot:3
+32 IF PXCABULD&'$DATA(PXCA("ERROR","IMMUNIZATION",PXCAPRV,PXCAINDX))!PXCAERRS
DO IMM(PXCAIMM,.PXCANUMB,PXCAPRV,PXCAERRS)
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
