PXVRPC1 ;BIR/ADM - IMM MANUFACTURER API ;08/16/2016
;;1.0;PCE PATIENT CARE ENCOUNTER;**215,216**;Aug 12, 1996;Build 11
;
Q
ILOT(PXVRETRN,PXVLK,PXVI,PXLOC) ; return list of immunization lot information
;Input:
; PXVRETRN - (required) return array of external field values
; PXVLK - (optional) information to be returned - defaults to list all entries (S:B)
; "R:XXX" - return entry with ien XXX
; "N:XXX" - return entry with lot number XXX
; "S:A" - return list of all active lot numbers
; "S:I" - return list of all inactive lot numbers
; "S:B" - return list of all lot numbers, active and inactive
; PXVI - (optional)
; 1 - return alternate array with internal values in delimited string
; PXLOC - (optional) Used to determine Institution (used when filtering Lot)
; Possible values are:
; "I:X": Institution (#4) IEN #X
; "V:X": Visit (#9000010) IEN #X
; "L:X": Hopital Location (#44) IEN #X
; If determination cannot be made based off input, then default to DUZ(2),
; and if DUZ(2) is not defined, default to Default Institution.
;
;Output:
; PXVRETRN - returned information is stored in ^TMP("PXVLST",$J))
; - return info format: Field Name^Field Value
; - error format: -1^error message
; - alternate array: caret delimited string with differing internal and
; external values separated by a tilde
;
N PXVARAY,PXVFLG,PXVNAME,PXVVAL,PXVCT,PXVIEN,PXVSUM,PXFIL,PXINST,PXINVAL,PXVF
S PXVARAY="^TMP(""PXVLST"",$J)" K @PXVARAY
S PXVLK=$S('$L($G(PXVLK)):"S:B",1:PXVLK)
I $G(PXVI)'=1 S PXVI=0
S PXINVAL=0 I $L($G(PXLOC)) D I PXINVAL D IIV Q
.S PXFIL=$P(PXLOC,":") I $L(PXFIL)>1!("IVL"'[PXFIL) S PXINVAL=1 Q
.S PXVF=$P(PXLOC,":",2) I 'PXVF S PXINVAL=1
I $L($G(PXLOC)) S PXINST=$$INST^PXVUTIL($G(PXLOC))
S PXVFLG=$P(PXVLK,":"),PXVVAL=$P(PXVLK,":",2)
I $L(PXVFLG)>1!("RNS"'[PXVFLG) D IIV Q
I PXVFLG="R",'$G(PXVVAL) S @PXVARAY@(0)="-1^Invalid input for immunization lot IEN" D TMPRET Q
I PXVFLG="R",'$D(^AUTTIML(PXVVAL)) S @PXVARAY@(0)="-1^Invalid input for immunization lot IEN" D TMPRET Q
I PXVFLG="N",'$L(PXVVAL) S @PXVARAY@(0)="-1^Invalid input for lot number" D TMPRET Q
I PXVFLG="N",'$D(^AUTTIML("B",PXVVAL)) S @PXVARAY@(0)="-1^Invalid input for lot number" D TMPRET Q
I PXVFLG="S",(PXVVAL'="A"&(PXVVAL'="B")&(PXVVAL'="I")) D IIV Q
S (PXVCT,PXVSUM)=0
I PXVFLG="R" S PXVIEN=PXVVAL D ONEL
I PXVFLG="N" S PXVIEN=0 F S PXVIEN=$O(^AUTTIML("B",PXVVAL,PXVIEN)) Q:'PXVIEN D ONEL
I PXVFLG="S" S PXVIEN=0 F S PXVIEN=$O(^AUTTIML(PXVIEN)) Q:'PXVIEN D ONEL
I 'PXVI S PXVNAME="" F S PXVNAME=$O(@PXVARAY@(PXVNAME)) Q:PXVNAME="" S PXVCT=PXVCT+1,@PXVARAY@(PXVNAME,0)="RECORD^"_PXVCT_" OF "_PXVSUM
I PXVI S @PXVARAY@(0)=PXVSUM_" RECORD"_$S(PXVSUM'>1:"",1:"S")
I PXVSUM=0 S @PXVARAY@(0)="0 RECORDS"
D TMPRET
Q
;
ONEL ; return array containing info for selected immunization lot
N PXV0,PXVFLD,PXVIENC,PXVY,PXVZ
S PXVIENC=PXVIEN_",",PXV0=^AUTTIML(PXVIEN,0)
I $G(PXINST),$P(PXV0,"^",10)'="",$P(PXV0,"^",10)'=PXINST Q
I PXVFLG="S",PXVVAL="A",$P(PXV0,"^",3) Q
I PXVFLG="S",PXVVAL="I",'$P(PXV0,"^",3) Q
S PXVSUM=PXVSUM+1
I 'PXVI D
.D GETS^DIQ(9999999.41,PXVIENC,".01;.02;.03;.04;.09;.1;.12;.15;.18","","PXVY")
.S PXVZ=0 F S PXVZ=$O(PXVY(9999999.41,PXVIENC,PXVZ)) Q:'PXVZ D
..D FIELD^DID(9999999.41,PXVZ,"","LABEL","PXVFLD")
..I PXVZ=.01 S PXVNAME=PXVY(9999999.41,PXVIENC,PXVZ),PXVNAME=PXVNAME_" "_PXVSUM
..S @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXVY(9999999.41,PXVIENC,PXVZ)
.S @PXVARAY@(PXVNAME,.001)="IEN^"_PXVIEN
I PXVI D
.D GETS^DIQ(9999999.41,PXVIENC,".02;.03;.04;.09;.1;.18","E","PXVY")
.S PXVZ=PXVIEN_"^"_$P(PXV0,"^")_"^"_$P(PXV0,"^",2)_"~"_PXVY(9999999.41,PXVIENC,.02,"E")_"^"_$P(PXV0,"^",3)_"~"_PXVY(9999999.41,PXVIENC,.03,"E")
.S PXVZ=PXVZ_"^"_$P(PXV0,"^",4)_"~"_PXVY(9999999.41,PXVIENC,.04,"E")_"^"_$P(PXV0,"^",9)_"~"_PXVY(9999999.41,PXVIENC,.09,"E")
.S PXVZ=PXVZ_"^"_$P(PXV0,"^",12)_"^"_$P(PXV0,"^",15)_"^"_$P(PXV0,"^",18)_"~"_PXVY(9999999.41,PXVIENC,.18,"E")
.S PXVZ=PXVZ_"^"_$P(PXV0,"^",10)_"~"_PXVY(9999999.41,PXVIENC,.1,"E")
.S @PXVARAY@(PXVIEN)=PXVZ
Q
;
IMAN(PXVRETRN,PXVLK,PXVDATE,PXVI) ; rpc to return immunization manufacturer information
;Input:
; PXVRETRN - (required) return array
; PXVLK - (optional) information to be returned - defaults to list all entries (S:B)
; R:XXX - return entry with ien XXX
; M:XXX - return entry with MVX code XXX
; N:XXX - return entry with imm manufacturer name XXX
; S:A - return list of all active manufacturers
; S:I - return list of all inactive manufacturers
; S:B - return list of all manufacturers, active and inactive
; PXVDATE - (optional) date for use in determining status - defaults to TODAY
; PXVI - (optional)
; 1 - return alternate array with internal values in delimited string
;
;Output:
; PXVRETRN - returned information is stored in ^TMP("PXVLST",$J))
; - return info format: Field Name^Field Value
; - error format: -1^error message
; - alternate array: caret delimited string with differing internal and
; external values separated by a tilde
;
N PXVARAY,PXVFLG,PXVNAME,PXVVAL,PXVCT,PXVIEN,PXVSUM
S PXVARAY="^TMP(""PXVLST"",$J)" K @PXVARAY
S PXVLK=$S('$L($G(PXVLK)):"S:B",1:PXVLK)
I $G(PXVI)'=1 S PXVI=0
S PXVFLG=$P(PXVLK,":"),PXVVAL=$P(PXVLK,":",2)
I $L(PXVFLG)>1!("RMNS"'[PXVFLG) D IIV Q
I PXVFLG="R",'$G(PXVVAL) S @PXVARAY@(0)="-1^Invalid input for manufacturer IEN" D TMPRET Q
I PXVFLG="R",'$D(^AUTTIMAN(PXVVAL)) S @PXVARAY@(0)="-1^Invalid input for manufacturer IEN" D TMPRET Q
I PXVFLG="M",'$L(PXVVAL) S @PXVARAY@(0)="-1^Invalid input for MVX code" D TMPRET Q
I PXVFLG="M",'$D(^AUTTIMAN("M",PXVVAL)) S @PXVARAY@(0)="-1^Invalid input for MVX code" D TMPRET Q
I PXVFLG="N",'$L(PXVVAL) S @PXVARAY@(0)="-1^Invalid input for manufacturer name" D TMPRET Q
I PXVFLG="N",'$D(^AUTTIMAN("B",$G(PXVVAL))) S @PXVARAY@(0)="-1^Invalid input for manufacturer name" D TMPRET Q
I PXVFLG="S",(PXVVAL'="A"&(PXVVAL'="B")&(PXVVAL'="I")) D IIV Q
S PXVDATE=$S('$L($G(PXVDATE)):DT,1:PXVDATE)
S (PXVCT,PXVSUM)=0
I PXVFLG="R" S PXVIEN=PXVVAL D ONEM
I PXVFLG="M" S PXVIEN=0 F S PXVIEN=$O(^AUTTIMAN("M",PXVVAL,PXVIEN)) Q:'PXVIEN D ONEM
I PXVFLG="N" S PXVIEN=0 F S PXVIEN=$O(^AUTTIMAN("B",PXVVAL,PXVIEN)) Q:'PXVIEN D ONEM
I PXVFLG="S" S PXVIEN=0 F S PXVIEN=$O(^AUTTIMAN(PXVIEN)) Q:'PXVIEN D ONEM
I 'PXVI S PXVNAME="" F S PXVNAME=$O(@PXVARAY@(PXVNAME)) Q:PXVNAME="" S PXVCT=PXVCT+1,@PXVARAY@(PXVNAME,0)="RECORD^"_PXVCT_" OF "_PXVSUM
I PXVI S @PXVARAY@(0)=PXVSUM_" RECORD"_$S(PXVSUM'>1:"",1:"S")
I PXVSUM=0 S @PXVARAY@(0)="0 RECORDS"
D TMPRET
Q
;
ONEM ; return array containing info for selected manufacturer
N PXVACT,PXVFILE,PXVFLD,PXVIENC,PXVP,PXVSTAT,PXV0,PXV2,PXVY,PXVZ,X
S PXVIENC=PXVIEN_",",PXV0=^AUTTIMAN(PXVIEN,0),PXVFILE=9999999.04 D STAT
I PXVFLG="S",PXVVAL="A",$P(PXV0,"^",3) Q
I PXVFLG="S",PXVVAL="I",'$P(PXV0,"^",3) Q
S PXVSUM=PXVSUM+1
I 'PXVI D
.D GETS^DIQ(9999999.04,PXVIENC,".01;.02;.03;201","","PXVY")
.S PXVZ=0 F S PXVZ=$O(PXVY(9999999.04,PXVIENC,PXVZ)) Q:'PXVZ D
..D FIELD^DID(9999999.04,PXVZ,"","LABEL","PXVFLD")
..I PXVZ=.01 S PXVNAME=PXVY(9999999.04,PXVIENC,PXVZ),PXVNAME=PXVNAME_" "_PXVSUM
..S @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXVY(9999999.04,PXVIENC,PXVZ)
.S @PXVARAY@(PXVNAME,"STATUS")="STATUS^"_PXVSTAT
.S @PXVARAY@(PXVNAME,.001)="IEN^"_PXVIEN
I PXVI D
.S PXVZ=PXVIEN_"^"_$P(PXV0,"^")_"^"_$P(PXV0,"^",2)_"^"_$P(PXV0,"^",3)_"~"_$S($P(PXV0,"^",3)=0:"ACTIVE",1:"INACTIVE")
.S PXVZ=PXVZ_"^"_$P($G(^AUTTIMAN(PXVIEN,2)),"^")_"^"_PXVSTAT
.S @PXVARAY@(PXVIEN)=PXVZ
Q
;
IVIS(PXVRETRN,PXVLK,PXVDATE) ; rpc to return vaccine information statement information
;Input:
; PXVRETRN - (required) return array
; PXVLK - (optional) information to be returned - defaults to list all entries (S:B)
; R:XXX - return entry with ien XXX
; N:XXX - return entry with VIS name XXX
; S:A - return list of all active VISs
; S:I - return list of all inactive VISs
; S:B - return list of all VISs, active and inactive
; PXVDATE - (optional) date for use in determining status - defaults to TODAY
;
;Output:
; PXVRETRN - returned information is stored in ^TMP("PXVLST",$J))
; - return info format: Field Name^Field Value
; - error format: -1^error message
;
N PXVARAY,PXVFLG,PXVNAME,PXVVAL,PXVCT,PXVIEN,PXVSUM
S PXVARAY="^TMP(""PXVLST"",$J)" K @PXVARAY
S PXVLK=$S('$L($G(PXVLK)):"S:B",1:PXVLK)
S PXVFLG=$P(PXVLK,":"),PXVVAL=$P(PXVLK,":",2)
I $L(PXVFLG)>1!("RNS"'[PXVFLG) D IIV Q
I PXVFLG="R",'$G(PXVVAL) S @PXVARAY@(0)="-1^Invalid input for VIS IEN" D TMPRET Q
I PXVFLG="R",'$D(^AUTTIVIS(PXVVAL)) S @PXVARAY@(0)="-1^Invalid input for VIS IEN" D TMPRET Q
I PXVFLG="N",'$L(PXVVAL) S @PXVARAY@(0)="-1^Invalid input for VIS name" D TMPRET Q
I PXVFLG="N",'$D(^AUTTIVIS("B",PXVVAL)) S @PXVARAY@(0)="-1^Invalid input for VIS name" D TMPRET Q
I PXVFLG="S",(PXVVAL'="A"&(PXVVAL'="B")&(PXVVAL'="I")) D IIV Q
S PXVDATE=$S('$L($G(PXVDATE)):DT,1:PXVDATE)
S (PXVCT,PXVSUM)=0
I PXVFLG="R" S PXVIEN=PXVVAL D ONEV
I PXVFLG="N" S PXVIEN=0 F S PXVIEN=$O(^AUTTIVIS("B",PXVVAL,PXVIEN)) Q:'PXVIEN D ONEV
I PXVFLG="S" S PXVIEN=0 F S PXVIEN=$O(^AUTTIVIS(PXVIEN)) Q:'PXVIEN D ONEV
S PXVNAME="" F S PXVNAME=$O(@PXVARAY@(PXVNAME)) Q:PXVNAME="" S PXVCT=PXVCT+1,@PXVARAY@(PXVNAME,0)="RECORD^"_PXVCT_" OF "_PXVSUM
I PXVSUM=0 S @PXVARAY@(0)="0 RECORDS"
D TMPRET
Q
;
ONEV ; return array containing info for VIS
N PXV,PXVACT,PXVFILE,PXVFLD,PXVIENC,PXVL,PXVP,PXVSTAT,PXVY,PXVZ
S PXVIENC=PXVIEN_",",PXVFILE=920 D STAT
I PXVFLG="S",PXVVAL="A",'PXVACT Q
I PXVFLG="S",PXVVAL="I",PXVACT Q
S PXVSUM=PXVSUM+1
D GETS^DIQ(920,PXVIENC,".01;.02;.03;.04;2;100;101","","PXVP")
S PXVZ=0 F S PXVZ=$O(PXVP(920,PXVIENC,PXVZ)) Q:'PXVZ D
.D FIELD^DID(920,PXVZ,"","LABEL","PXVFLD")
.I PXVZ=.01 S PXVNAME=PXVP(920,PXVIENC,PXVZ),PXVNAME=PXVNAME_" "_PXVSUM
.I PXVZ=.04,PXVP(920,PXVIENC,PXVZ) N X S X=PXVP(920,PXVIENC,PXVZ) D Q
..S PXV=$S(X=1:"ENGLISH",X=2:"GERMAN",X=3:"SPANISH",X=4:"FRENCH",X=5:"FINNISH",X=6:"ITALIAN",X=7:"PORTUGUESE",X=8:"ARABIC",X=11:"RUSSIAN",X=12:"GREEK",X=18:"HEBREW",1:X)
..S @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXV
.I PXVZ=2 D Q
..I PXVP(920,PXVIENC,PXVZ)="" S @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXVP(920,PXVIENC,PXVZ) Q
..S PXVL=0 F S PXVL=$O(PXVP(920,PXVIENC,PXVZ,PXVL)) Q:'PXVL D
...S @PXVARAY@(PXVNAME,PXVZ,PXVL)=PXVFLD("LABEL")_" "_PXVL_"^"_PXVP(920,PXVIENC,PXVZ,PXVL)
.S @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXVP(920,PXVIENC,PXVZ)
S @PXVARAY@(PXVNAME,"STATUS")="STATUS^"_PXVSTAT
S @PXVARAY@(PXVNAME,.001)="IEN^"_PXVIEN
Q
;
STAT ;
S PXVACT=$P($$GETSTAT^XTID(PXVFILE,,PXVIENC,$G(PXVDATE)),"^")
I PXVACT="" S PXVACT=1
S PXVSTAT=$S(PXVACT=0:"INACTIVE",1:"ACTIVE")
Q
;
IIV ; return invalid input message
S @PXVARAY@(0)="-1^Invalid input value"
TMPRET ;
S PXVRETRN=$NA(@PXVARAY)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVRPC1 11535 printed Nov 22, 2024@17:41:58 Page 2
PXVRPC1 ;BIR/ADM - IMM MANUFACTURER API ;08/16/2016
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215,216**;Aug 12, 1996;Build 11
+2 ;
+3 QUIT
ILOT(PXVRETRN,PXVLK,PXVI,PXLOC) ; return list of immunization lot information
+1 ;Input:
+2 ; PXVRETRN - (required) return array of external field values
+3 ; PXVLK - (optional) information to be returned - defaults to list all entries (S:B)
+4 ; "R:XXX" - return entry with ien XXX
+5 ; "N:XXX" - return entry with lot number XXX
+6 ; "S:A" - return list of all active lot numbers
+7 ; "S:I" - return list of all inactive lot numbers
+8 ; "S:B" - return list of all lot numbers, active and inactive
+9 ; PXVI - (optional)
+10 ; 1 - return alternate array with internal values in delimited string
+11 ; PXLOC - (optional) Used to determine Institution (used when filtering Lot)
+12 ; Possible values are:
+13 ; "I:X": Institution (#4) IEN #X
+14 ; "V:X": Visit (#9000010) IEN #X
+15 ; "L:X": Hopital Location (#44) IEN #X
+16 ; If determination cannot be made based off input, then default to DUZ(2),
+17 ; and if DUZ(2) is not defined, default to Default Institution.
+18 ;
+19 ;Output:
+20 ; PXVRETRN - returned information is stored in ^TMP("PXVLST",$J))
+21 ; - return info format: Field Name^Field Value
+22 ; - error format: -1^error message
+23 ; - alternate array: caret delimited string with differing internal and
+24 ; external values separated by a tilde
+25 ;
+26 NEW PXVARAY,PXVFLG,PXVNAME,PXVVAL,PXVCT,PXVIEN,PXVSUM,PXFIL,PXINST,PXINVAL,PXVF
+27 SET PXVARAY="^TMP(""PXVLST"",$J)"
KILL @PXVARAY
+28 SET PXVLK=$SELECT('$LENGTH($GET(PXVLK)):"S:B",1:PXVLK)
+29 IF $GET(PXVI)'=1
SET PXVI=0
+30 SET PXINVAL=0
IF $LENGTH($GET(PXLOC))
Begin DoDot:1
+31 SET PXFIL=$PIECE(PXLOC,":")
IF $LENGTH(PXFIL)>1!("IVL"'[PXFIL)
SET PXINVAL=1
QUIT
+32 SET PXVF=$PIECE(PXLOC,":",2)
IF 'PXVF
SET PXINVAL=1
End DoDot:1
IF PXINVAL
DO IIV
QUIT
+33 IF $LENGTH($GET(PXLOC))
SET PXINST=$$INST^PXVUTIL($GET(PXLOC))
+34 SET PXVFLG=$PIECE(PXVLK,":")
SET PXVVAL=$PIECE(PXVLK,":",2)
+35 IF $LENGTH(PXVFLG)>1!("RNS"'[PXVFLG)
DO IIV
QUIT
+36 IF PXVFLG="R"
IF '$GET(PXVVAL)
SET @PXVARAY@(0)="-1^Invalid input for immunization lot IEN"
DO TMPRET
QUIT
+37 IF PXVFLG="R"
IF '$DATA(^AUTTIML(PXVVAL))
SET @PXVARAY@(0)="-1^Invalid input for immunization lot IEN"
DO TMPRET
QUIT
+38 IF PXVFLG="N"
IF '$LENGTH(PXVVAL)
SET @PXVARAY@(0)="-1^Invalid input for lot number"
DO TMPRET
QUIT
+39 IF PXVFLG="N"
IF '$DATA(^AUTTIML("B",PXVVAL))
SET @PXVARAY@(0)="-1^Invalid input for lot number"
DO TMPRET
QUIT
+40 IF PXVFLG="S"
IF (PXVVAL'="A"&(PXVVAL'="B")&(PXVVAL'="I"))
DO IIV
QUIT
+41 SET (PXVCT,PXVSUM)=0
+42 IF PXVFLG="R"
SET PXVIEN=PXVVAL
DO ONEL
+43 IF PXVFLG="N"
SET PXVIEN=0
FOR
SET PXVIEN=$ORDER(^AUTTIML("B",PXVVAL,PXVIEN))
if 'PXVIEN
QUIT
DO ONEL
+44 IF PXVFLG="S"
SET PXVIEN=0
FOR
SET PXVIEN=$ORDER(^AUTTIML(PXVIEN))
if 'PXVIEN
QUIT
DO ONEL
+45 IF 'PXVI
SET PXVNAME=""
FOR
SET PXVNAME=$ORDER(@PXVARAY@(PXVNAME))
if PXVNAME=""
QUIT
SET PXVCT=PXVCT+1
SET @PXVARAY@(PXVNAME,0)="RECORD^"_PXVCT_" OF "_PXVSUM
+46 IF PXVI
SET @PXVARAY@(0)=PXVSUM_" RECORD"_$SELECT(PXVSUM'>1:"",1:"S")
+47 IF PXVSUM=0
SET @PXVARAY@(0)="0 RECORDS"
+48 DO TMPRET
+49 QUIT
+50 ;
ONEL ; return array containing info for selected immunization lot
+1 NEW PXV0,PXVFLD,PXVIENC,PXVY,PXVZ
+2 SET PXVIENC=PXVIEN_","
SET PXV0=^AUTTIML(PXVIEN,0)
+3 IF $GET(PXINST)
IF $PIECE(PXV0,"^",10)'=""
IF $PIECE(PXV0,"^",10)'=PXINST
QUIT
+4 IF PXVFLG="S"
IF PXVVAL="A"
IF $PIECE(PXV0,"^",3)
QUIT
+5 IF PXVFLG="S"
IF PXVVAL="I"
IF '$PIECE(PXV0,"^",3)
QUIT
+6 SET PXVSUM=PXVSUM+1
+7 IF 'PXVI
Begin DoDot:1
+8 DO GETS^DIQ(9999999.41,PXVIENC,".01;.02;.03;.04;.09;.1;.12;.15;.18","","PXVY")
+9 SET PXVZ=0
FOR
SET PXVZ=$ORDER(PXVY(9999999.41,PXVIENC,PXVZ))
if 'PXVZ
QUIT
Begin DoDot:2
+10 DO FIELD^DID(9999999.41,PXVZ,"","LABEL","PXVFLD")
+11 IF PXVZ=.01
SET PXVNAME=PXVY(9999999.41,PXVIENC,PXVZ)
SET PXVNAME=PXVNAME_" "_PXVSUM
+12 SET @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXVY(9999999.41,PXVIENC,PXVZ)
End DoDot:2
+13 SET @PXVARAY@(PXVNAME,.001)="IEN^"_PXVIEN
End DoDot:1
+14 IF PXVI
Begin DoDot:1
+15 DO GETS^DIQ(9999999.41,PXVIENC,".02;.03;.04;.09;.1;.18","E","PXVY")
+16 SET PXVZ=PXVIEN_"^"_$PIECE(PXV0,"^")_"^"_$PIECE(PXV0,"^",2)_"~"_PXVY(9999999.41,PXVIENC,.02,"E")_"^"_$PIECE(PXV0,"^",3)_"~"_PXVY(9999999.41,PXVIENC,.03,"E")
+17 SET PXVZ=PXVZ_"^"_$PIECE(PXV0,"^",4)_"~"_PXVY(9999999.41,PXVIENC,.04,"E")_"^"_$PIECE(PXV0,"^",9)_"~"_PXVY(9999999.41,PXVIENC,.09,"E")
+18 SET PXVZ=PXVZ_"^"_$PIECE(PXV0,"^",12)_"^"_$PIECE(PXV0,"^",15)_"^"_$PIECE(PXV0,"^",18)_"~"_PXVY(9999999.41,PXVIENC,.18,"E")
+19 SET PXVZ=PXVZ_"^"_$PIECE(PXV0,"^",10)_"~"_PXVY(9999999.41,PXVIENC,.1,"E")
+20 SET @PXVARAY@(PXVIEN)=PXVZ
End DoDot:1
+21 QUIT
+22 ;
IMAN(PXVRETRN,PXVLK,PXVDATE,PXVI) ; rpc to return immunization manufacturer information
+1 ;Input:
+2 ; PXVRETRN - (required) return array
+3 ; PXVLK - (optional) information to be returned - defaults to list all entries (S:B)
+4 ; R:XXX - return entry with ien XXX
+5 ; M:XXX - return entry with MVX code XXX
+6 ; N:XXX - return entry with imm manufacturer name XXX
+7 ; S:A - return list of all active manufacturers
+8 ; S:I - return list of all inactive manufacturers
+9 ; S:B - return list of all manufacturers, active and inactive
+10 ; PXVDATE - (optional) date for use in determining status - defaults to TODAY
+11 ; PXVI - (optional)
+12 ; 1 - return alternate array with internal values in delimited string
+13 ;
+14 ;Output:
+15 ; PXVRETRN - returned information is stored in ^TMP("PXVLST",$J))
+16 ; - return info format: Field Name^Field Value
+17 ; - error format: -1^error message
+18 ; - alternate array: caret delimited string with differing internal and
+19 ; external values separated by a tilde
+20 ;
+21 NEW PXVARAY,PXVFLG,PXVNAME,PXVVAL,PXVCT,PXVIEN,PXVSUM
+22 SET PXVARAY="^TMP(""PXVLST"",$J)"
KILL @PXVARAY
+23 SET PXVLK=$SELECT('$LENGTH($GET(PXVLK)):"S:B",1:PXVLK)
+24 IF $GET(PXVI)'=1
SET PXVI=0
+25 SET PXVFLG=$PIECE(PXVLK,":")
SET PXVVAL=$PIECE(PXVLK,":",2)
+26 IF $LENGTH(PXVFLG)>1!("RMNS"'[PXVFLG)
DO IIV
QUIT
+27 IF PXVFLG="R"
IF '$GET(PXVVAL)
SET @PXVARAY@(0)="-1^Invalid input for manufacturer IEN"
DO TMPRET
QUIT
+28 IF PXVFLG="R"
IF '$DATA(^AUTTIMAN(PXVVAL))
SET @PXVARAY@(0)="-1^Invalid input for manufacturer IEN"
DO TMPRET
QUIT
+29 IF PXVFLG="M"
IF '$LENGTH(PXVVAL)
SET @PXVARAY@(0)="-1^Invalid input for MVX code"
DO TMPRET
QUIT
+30 IF PXVFLG="M"
IF '$DATA(^AUTTIMAN("M",PXVVAL))
SET @PXVARAY@(0)="-1^Invalid input for MVX code"
DO TMPRET
QUIT
+31 IF PXVFLG="N"
IF '$LENGTH(PXVVAL)
SET @PXVARAY@(0)="-1^Invalid input for manufacturer name"
DO TMPRET
QUIT
+32 IF PXVFLG="N"
IF '$DATA(^AUTTIMAN("B",$GET(PXVVAL)))
SET @PXVARAY@(0)="-1^Invalid input for manufacturer name"
DO TMPRET
QUIT
+33 IF PXVFLG="S"
IF (PXVVAL'="A"&(PXVVAL'="B")&(PXVVAL'="I"))
DO IIV
QUIT
+34 SET PXVDATE=$SELECT('$LENGTH($GET(PXVDATE)):DT,1:PXVDATE)
+35 SET (PXVCT,PXVSUM)=0
+36 IF PXVFLG="R"
SET PXVIEN=PXVVAL
DO ONEM
+37 IF PXVFLG="M"
SET PXVIEN=0
FOR
SET PXVIEN=$ORDER(^AUTTIMAN("M",PXVVAL,PXVIEN))
if 'PXVIEN
QUIT
DO ONEM
+38 IF PXVFLG="N"
SET PXVIEN=0
FOR
SET PXVIEN=$ORDER(^AUTTIMAN("B",PXVVAL,PXVIEN))
if 'PXVIEN
QUIT
DO ONEM
+39 IF PXVFLG="S"
SET PXVIEN=0
FOR
SET PXVIEN=$ORDER(^AUTTIMAN(PXVIEN))
if 'PXVIEN
QUIT
DO ONEM
+40 IF 'PXVI
SET PXVNAME=""
FOR
SET PXVNAME=$ORDER(@PXVARAY@(PXVNAME))
if PXVNAME=""
QUIT
SET PXVCT=PXVCT+1
SET @PXVARAY@(PXVNAME,0)="RECORD^"_PXVCT_" OF "_PXVSUM
+41 IF PXVI
SET @PXVARAY@(0)=PXVSUM_" RECORD"_$SELECT(PXVSUM'>1:"",1:"S")
+42 IF PXVSUM=0
SET @PXVARAY@(0)="0 RECORDS"
+43 DO TMPRET
+44 QUIT
+45 ;
ONEM ; return array containing info for selected manufacturer
+1 NEW PXVACT,PXVFILE,PXVFLD,PXVIENC,PXVP,PXVSTAT,PXV0,PXV2,PXVY,PXVZ,X
+2 SET PXVIENC=PXVIEN_","
SET PXV0=^AUTTIMAN(PXVIEN,0)
SET PXVFILE=9999999.04
DO STAT
+3 IF PXVFLG="S"
IF PXVVAL="A"
IF $PIECE(PXV0,"^",3)
QUIT
+4 IF PXVFLG="S"
IF PXVVAL="I"
IF '$PIECE(PXV0,"^",3)
QUIT
+5 SET PXVSUM=PXVSUM+1
+6 IF 'PXVI
Begin DoDot:1
+7 DO GETS^DIQ(9999999.04,PXVIENC,".01;.02;.03;201","","PXVY")
+8 SET PXVZ=0
FOR
SET PXVZ=$ORDER(PXVY(9999999.04,PXVIENC,PXVZ))
if 'PXVZ
QUIT
Begin DoDot:2
+9 DO FIELD^DID(9999999.04,PXVZ,"","LABEL","PXVFLD")
+10 IF PXVZ=.01
SET PXVNAME=PXVY(9999999.04,PXVIENC,PXVZ)
SET PXVNAME=PXVNAME_" "_PXVSUM
+11 SET @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXVY(9999999.04,PXVIENC,PXVZ)
End DoDot:2
+12 SET @PXVARAY@(PXVNAME,"STATUS")="STATUS^"_PXVSTAT
+13 SET @PXVARAY@(PXVNAME,.001)="IEN^"_PXVIEN
End DoDot:1
+14 IF PXVI
Begin DoDot:1
+15 SET PXVZ=PXVIEN_"^"_$PIECE(PXV0,"^")_"^"_$PIECE(PXV0,"^",2)_"^"_$PIECE(PXV0,"^",3)_"~"_$SELECT($PIECE(PXV0,"^",3)=0:"ACTIVE",1:"INACTIVE")
+16 SET PXVZ=PXVZ_"^"_$PIECE($GET(^AUTTIMAN(PXVIEN,2)),"^")_"^"_PXVSTAT
+17 SET @PXVARAY@(PXVIEN)=PXVZ
End DoDot:1
+18 QUIT
+19 ;
IVIS(PXVRETRN,PXVLK,PXVDATE) ; rpc to return vaccine information statement information
+1 ;Input:
+2 ; PXVRETRN - (required) return array
+3 ; PXVLK - (optional) information to be returned - defaults to list all entries (S:B)
+4 ; R:XXX - return entry with ien XXX
+5 ; N:XXX - return entry with VIS name XXX
+6 ; S:A - return list of all active VISs
+7 ; S:I - return list of all inactive VISs
+8 ; S:B - return list of all VISs, active and inactive
+9 ; PXVDATE - (optional) date for use in determining status - defaults to TODAY
+10 ;
+11 ;Output:
+12 ; PXVRETRN - returned information is stored in ^TMP("PXVLST",$J))
+13 ; - return info format: Field Name^Field Value
+14 ; - error format: -1^error message
+15 ;
+16 NEW PXVARAY,PXVFLG,PXVNAME,PXVVAL,PXVCT,PXVIEN,PXVSUM
+17 SET PXVARAY="^TMP(""PXVLST"",$J)"
KILL @PXVARAY
+18 SET PXVLK=$SELECT('$LENGTH($GET(PXVLK)):"S:B",1:PXVLK)
+19 SET PXVFLG=$PIECE(PXVLK,":")
SET PXVVAL=$PIECE(PXVLK,":",2)
+20 IF $LENGTH(PXVFLG)>1!("RNS"'[PXVFLG)
DO IIV
QUIT
+21 IF PXVFLG="R"
IF '$GET(PXVVAL)
SET @PXVARAY@(0)="-1^Invalid input for VIS IEN"
DO TMPRET
QUIT
+22 IF PXVFLG="R"
IF '$DATA(^AUTTIVIS(PXVVAL))
SET @PXVARAY@(0)="-1^Invalid input for VIS IEN"
DO TMPRET
QUIT
+23 IF PXVFLG="N"
IF '$LENGTH(PXVVAL)
SET @PXVARAY@(0)="-1^Invalid input for VIS name"
DO TMPRET
QUIT
+24 IF PXVFLG="N"
IF '$DATA(^AUTTIVIS("B",PXVVAL))
SET @PXVARAY@(0)="-1^Invalid input for VIS name"
DO TMPRET
QUIT
+25 IF PXVFLG="S"
IF (PXVVAL'="A"&(PXVVAL'="B")&(PXVVAL'="I"))
DO IIV
QUIT
+26 SET PXVDATE=$SELECT('$LENGTH($GET(PXVDATE)):DT,1:PXVDATE)
+27 SET (PXVCT,PXVSUM)=0
+28 IF PXVFLG="R"
SET PXVIEN=PXVVAL
DO ONEV
+29 IF PXVFLG="N"
SET PXVIEN=0
FOR
SET PXVIEN=$ORDER(^AUTTIVIS("B",PXVVAL,PXVIEN))
if 'PXVIEN
QUIT
DO ONEV
+30 IF PXVFLG="S"
SET PXVIEN=0
FOR
SET PXVIEN=$ORDER(^AUTTIVIS(PXVIEN))
if 'PXVIEN
QUIT
DO ONEV
+31 SET PXVNAME=""
FOR
SET PXVNAME=$ORDER(@PXVARAY@(PXVNAME))
if PXVNAME=""
QUIT
SET PXVCT=PXVCT+1
SET @PXVARAY@(PXVNAME,0)="RECORD^"_PXVCT_" OF "_PXVSUM
+32 IF PXVSUM=0
SET @PXVARAY@(0)="0 RECORDS"
+33 DO TMPRET
+34 QUIT
+35 ;
ONEV ; return array containing info for VIS
+1 NEW PXV,PXVACT,PXVFILE,PXVFLD,PXVIENC,PXVL,PXVP,PXVSTAT,PXVY,PXVZ
+2 SET PXVIENC=PXVIEN_","
SET PXVFILE=920
DO STAT
+3 IF PXVFLG="S"
IF PXVVAL="A"
IF 'PXVACT
QUIT
+4 IF PXVFLG="S"
IF PXVVAL="I"
IF PXVACT
QUIT
+5 SET PXVSUM=PXVSUM+1
+6 DO GETS^DIQ(920,PXVIENC,".01;.02;.03;.04;2;100;101","","PXVP")
+7 SET PXVZ=0
FOR
SET PXVZ=$ORDER(PXVP(920,PXVIENC,PXVZ))
if 'PXVZ
QUIT
Begin DoDot:1
+8 DO FIELD^DID(920,PXVZ,"","LABEL","PXVFLD")
+9 IF PXVZ=.01
SET PXVNAME=PXVP(920,PXVIENC,PXVZ)
SET PXVNAME=PXVNAME_" "_PXVSUM
+10 IF PXVZ=.04
IF PXVP(920,PXVIENC,PXVZ)
NEW X
SET X=PXVP(920,PXVIENC,PXVZ)
Begin DoDot:2
+11 SET PXV=$SELECT(X=1:"ENGLISH",X=2:"GERMAN",X=3:"SPANISH",X=4:"FRENCH",X=5:"FINNISH",X=6:"ITALIAN",X=7:"PORTUGUESE",X=8:"ARABIC",X=11:"RUSSIAN",X=12:"GREEK",X=18:"HEBREW",1:X)
+12 SET @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXV
End DoDot:2
QUIT
+13 IF PXVZ=2
Begin DoDot:2
+14 IF PXVP(920,PXVIENC,PXVZ)=""
SET @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXVP(920,PXVIENC,PXVZ)
QUIT
+15 SET PXVL=0
FOR
SET PXVL=$ORDER(PXVP(920,PXVIENC,PXVZ,PXVL))
if 'PXVL
QUIT
Begin DoDot:3
+16 SET @PXVARAY@(PXVNAME,PXVZ,PXVL)=PXVFLD("LABEL")_" "_PXVL_"^"_PXVP(920,PXVIENC,PXVZ,PXVL)
End DoDot:3
End DoDot:2
QUIT
+17 SET @PXVARAY@(PXVNAME,PXVZ)=PXVFLD("LABEL")_"^"_PXVP(920,PXVIENC,PXVZ)
End DoDot:1
+18 SET @PXVARAY@(PXVNAME,"STATUS")="STATUS^"_PXVSTAT
+19 SET @PXVARAY@(PXVNAME,.001)="IEN^"_PXVIEN
+20 QUIT
+21 ;
STAT ;
+1 SET PXVACT=$PIECE($$GETSTAT^XTID(PXVFILE,,PXVIENC,$GET(PXVDATE)),"^")
+2 IF PXVACT=""
SET PXVACT=1
+3 SET PXVSTAT=$SELECT(PXVACT=0:"INACTIVE",1:"ACTIVE")
+4 QUIT
+5 ;
IIV ; return invalid input message
+1 SET @PXVARAY@(0)="-1^Invalid input value"
TMPRET ;
+1 SET PXVRETRN=$NAME(@PXVARAY)
+2 QUIT
+3 ;
