- 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 Mar 13, 2025@21:36:41 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 ;
