Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXVRPC3

PXVRPC3.m

Go to the documentation of this file.
  1. PXVRPC3 ;MSC/DKA - VIMM 2.0 RPC code to return list of Immunizations ;10/27/2015 13:36
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**215**;Aug 12, 1996;Build 10
  1. ;
  1. Q
  1. IMMDATA(PXVRET,PXVFLTR,SUBFILES) ; Return array of entries from IMMUNIZATION, File #9999999.14
  1. ; PXVFLTR can have one of these values:
  1. ; R:XXX - Return entry with IEN XXX.
  1. ; S:A - List of Active Immunizations (default)
  1. ; S:H - List of [Selectable for] Historic Immunizations
  1. ; S:* - All records (Including Inactive Immunizations)
  1. ; SUBFILES is 1 or Y to include the subfiles when returning the data
  1. ; If SUBFILES is 0 or N (or not specified) then return just this subset of fields:
  1. ; IEN, NAME, SHORT NAME, CVX CODE, MAX # IN SERIES, INACTIVE FLAG,
  1. ; MNEMONIC, ACRONYM, SELECTABLE FOR HISTORIC)
  1. N PXVFILE,PXVIEN,PXVIENS,PXVCNT,PXVGBL,PXVDATA,PXVSTR,PXVREF,PXVERR,PXVSUB,PXVSUBC,PXVDELIM,PXVSBSCR
  1. N PXVBRIEF,PXVACTIV,PXVHISTR,PXVINCLU,PXVTEMP,PXVDLM1,PXVDLM2,PXVDLM3,PXVVALID,PXVERMSG,PXVTYPE
  1. N PXVSDATA,PXVSERR,PXVFMT,PXVSUB2,PXVSUB2C,PXVSVSC2
  1. S SUBFILES=+$TR($E($G(SUBFILES,0)),"YyNn","1100")
  1. S PXVFLTR=$G(PXVFLTR,"S:A") S:PXVFLTR="" PXVFLTR="S:A"
  1. S PXVGBL=$NA(^AUTTIMM)
  1. K PXVRET S PXVRET=$NA(^TMP("PXVRPC3",$J)) K @PXVRET
  1. S PXVVALID=1 ; Assume the parameters are valid until proven otherwise
  1. I $E(PXVFLTR,1,2)="R:" D
  1. . S PXVFMT="R",PXVIEN=$E(PXVFLTR,3,$L(PXVFLTR)),PXVTYPE="*"
  1. . S:PXVIEN'=+PXVIEN!(PXVIEN<1) PXVVALID=0,PXVERMSG="Invalid IEN specified for R: format in PXVFLTR parameter"
  1. . Q:PXVIEN=""
  1. . S:'$D(@PXVGBL@(PXVIEN)) PXVVALID=0,PXVERMSG="Entry not found for the specified IEN"
  1. E I $E(PXVFLTR,1,2)="S:" D
  1. . S PXVFMT="S",PXVTYPE=$E(PXVFLTR,3)
  1. . S:PXVTYPE'="A"&(PXVTYPE'="H")&(PXVTYPE'="*") PXVVALID=0,PXVERMSG="Invalid type specified for S: format in PXVFLTR parameter"
  1. . S ACTONLY=PXVTYPE'="H" ; ActiveOnly is any type (A or *) except H
  1. . S SELHIST=PXVTYPE'="A" ; Selectable for Historic is any type (H or *) except A
  1. E S PXVVALID=0,PXVERMSG="Invalid Parameter(s)"
  1. I 'PXVVALID S @PXVRET@(0)=-1_U_PXVERMSG Q
  1. S PXVBRIEF=".01;.02;.03;.05;.07;8801;8802;8803"
  1. S PXVCNT=0
  1. S PXVFILE=9999999.14
  1. I PXVFMT="R" D
  1. . D GETFLDS
  1. E I PXVFMT="S" D
  1. . S PXVIEN=0
  1. . F S PXVIEN=$O(@PXVGBL@(PXVIEN)) Q:'PXVIEN D GETFLDS
  1. S @PXVRET@(0)=PXVCNT ; Put the number of returned records in the first node of the array
  1. Q
  1. GETFLDS ; Get fields for one IEN
  1. S PXVIENS=PXVIEN_","
  1. K PXVDATA,PXVERR
  1. I 'SUBFILES D GETS^DIQ(PXVFILE,PXVIENS,PXVBRIEF,"I","PXVDATA","PXVERR")
  1. I SUBFILES D GETS^DIQ(PXVFILE,PXVIENS,"**","IE","PXVDATA","PXVERR")
  1. S PXVREF=$NA(PXVDATA(PXVFILE,PXVIENS))
  1. S PXVSTR=""
  1. S $P(PXVSTR,U,1)=PXVIEN
  1. ; NAME
  1. S $P(PXVSTR,U,2)=@PXVREF@(.01,"I")
  1. S $P(PXVSTR,U,3)=@PXVREF@(.02,"I")
  1. S $P(PXVSTR,U,4)=@PXVREF@(.03,"I")
  1. S $P(PXVSTR,U,5)=@PXVREF@(.05,"I")
  1. ; INACTIVE FLAG - Return 0 or 1 instead of "" or 1
  1. S (PXVTEMP,$P(PXVSTR,U,6))=+@PXVREF@(.07,"I")
  1. S PXVACTIV='PXVTEMP
  1. S $P(PXVSTR,U,7)=@PXVREF@(8801,"I")
  1. S $P(PXVSTR,U,8)=@PXVREF@(8802,"I")
  1. S (PXVTEMP,$P(PXVSTR,U,9))=@PXVREF@(8803,"I")
  1. S PXVHISTR=PXVTEMP="Y"
  1. S PXVINCLU=1 ; Assume the record is to be included until proven otherwise
  1. I PXVFMT'="R",PXVTYPE'="*" D
  1. . I ACTONLY,'PXVACTIV S PXVINCLU=0
  1. . E I SELHIST,'PXVHISTR S PXVINCLU=0
  1. Q:'PXVINCLU
  1. D:SUBFILES SUBFILES
  1. S PXVCNT=PXVCNT+1
  1. S @PXVRET@(PXVCNT)=PXVSTR
  1. Q
  1. SUBFILES ; Add the subfile multiples to the array
  1. ; Subfiles:
  1. S PXVDLM1="|",PXVDLM2="~",PXVDLM3=";;"
  1. ; Field 2 - CDC FULL VACCINE NAME
  1. ; There's only one entry in Field 2 for each Immunization, but that may change
  1. S PXVSUB="",PXVSUBC=0
  1. F S PXVSUBC=PXVSUBC+1 Q:'$D(@PXVREF@(2,PXVSUBC)) D
  1. . S $P(PXVSUB,PXVDLM1,PXVSUBC)=@PXVREF@(2,PXVSUBC)
  1. S $P(PXVSTR,U,10)=PXVSUB
  1. ; Field 3 - CODING SYSTEM
  1. S PXVREF=$NA(PXVDATA(PXVFILE_"3"))
  1. S PXVSBSCR="",PXVSUB="",PXVSUBC=0
  1. F S PXVSBSCR=$O(@PXVREF@(PXVSBSCR)) Q:PXVSBSCR="" D
  1. . S PXVSUBC=PXVSUBC+1
  1. . K PXVSDATA,PXVSERR
  1. . D GETS^DIQ(PXVFILE_"3",PXVSBSCR,"**","","PXVSDATA","PXVSERR")
  1. . S PXVSVSC2="",PXVSUB2C=0,PXVSUB2=""
  1. . F S PXVSVSC2=$O(PXVSDATA(PXVFILE_"31",PXVSVSC2)) Q:PXVSVSC2="" D
  1. . . S PXVSUB2C=PXVSUB2C+1
  1. . . S $P(PXVSUB2,PXVDLM3,PXVSUB2C)=PXVSDATA(PXVFILE_"31",PXVSVSC2,.01)
  1. . S $P(PXVSUB,PXVDLM1,PXVSUBC)=@PXVREF@(PXVSBSCR,.01,"I")_PXVDLM2_PXVSUB2
  1. S $P(PXVSTR,U,11)=PXVSUB
  1. ; Field 4 - VACCINE INFORMATION STATEMENT
  1. S PXVREF=$NA(PXVDATA(PXVFILE_"4"))
  1. S PXVSBSCR="",PXVSUB="",PXVSUBC=0
  1. F S PXVSBSCR=$O(@PXVREF@(PXVSBSCR)) Q:PXVSBSCR="" D
  1. . S PXVSUBC=PXVSUBC+1
  1. . S $P(PXVSUB,PXVDLM1,PXVSUBC)=@PXVREF@(PXVSBSCR,.01,"I")_PXVDLM2_@PXVREF@(PXVSBSCR,.01,"E")
  1. S $P(PXVSTR,U,12)=PXVSUB
  1. ; Field 5 - CDC PRODUCT NAME
  1. S PXVREF=$NA(PXVDATA(PXVFILE_"5"))
  1. S PXVSBSCR="",PXVSUB="",PXVSUBC=0
  1. F S PXVSBSCR=$O(@PXVREF@(PXVSBSCR)) Q:PXVSBSCR="" D
  1. . S PXVSUBC=PXVSUBC+1
  1. . S $P(PXVSUB,PXVDLM1,PXVSUBC)=@PXVREF@(PXVSBSCR,.01,"I")
  1. S $P(PXVSTR,U,13)=PXVSUB
  1. ; Field 7 - VACCINE GROUP NAME
  1. S PXVREF=$NA(PXVDATA(PXVFILE_"7"))
  1. S PXVSBSCR="",PXVSUB="",PXVSUBC=0
  1. F S PXVSBSCR=$O(@PXVREF@(PXVSBSCR)) Q:PXVSBSCR="" D
  1. . S PXVSUBC=PXVSUBC+1
  1. . S $P(PXVSUB,PXVDLM1,PXVSUBC)=@PXVREF@(PXVSBSCR,.01,"I")
  1. S $P(PXVSTR,U,14)=PXVSUB
  1. ; Field 10 - SYNONYM
  1. S PXVREF=$NA(PXVDATA(PXVFILE_"1"))
  1. S PXVSBSCR="",PXVSUB="",PXVSUBC=0
  1. F S PXVSBSCR=$O(@PXVREF@(PXVSBSCR)) Q:PXVSBSCR="" D
  1. . S PXVSUBC=PXVSUBC+1
  1. . S $P(PXVSUB,PXVDLM1,PXVSUBC)=@PXVREF@(PXVSBSCR,.01,"I")
  1. S $P(PXVSTR,U,15)=PXVSUB
  1. ; Field 99.991 - EFFECTIVE DATE/TIME
  1. S PXVREF=$NA(PXVDATA(PXVFILE_"99"))
  1. S PXVSBSCR="",PXVSUB="",PXVSUBC=0
  1. F S PXVSBSCR=$O(@PXVREF@(PXVSBSCR)) Q:PXVSBSCR="" D
  1. . S PXVSUBC=PXVSUBC+1
  1. . S $P(PXVSUB,PXVDLM1,PXVSUBC)=@PXVREF@(PXVSBSCR,.01,"I")_PXVDLM2_@PXVREF@(PXVSBSCR,.02,"I")
  1. S $P(PXVSTR,U,16)=PXVSUB
  1. Q