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

PXRPC.m

Go to the documentation of this file. 
  1. PXRPC ;ISL/JLC - PCE DATA2PCE RPC ;Jul 20, 2021@08:24:07
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**200,209,210,215,216,211,217**;Aug 12, 1996;Build 134
  1.  ;
  1.  ; Reference to UCUMDATA^LEXMUCUM supported by ICR #6225
  1.  ;
  1.  ;
  1. SAVE(OK,PCELIST,LOC,PKGNAME,SRC,PXAVST,PXRETVST) ; save PCE information
  1.  ;
  1.  N PXRET
  1.  ;
  1.  D SAVE2(.PXRET,.PCELIST,.PKGNAME,.SRC,.PXAVST)
  1.  S OK=$G(PXRET(0))
  1.  I '$G(PXRETVST) S OK=$P(OK,U,1)
  1.  Q
  1.  ;
  1. SAVE2(OK,PCELIST,PKGNAME,SRC,PXAVST) ; save PCE information - and return err info
  1.  ;
  1.  N PXAPI,PXERRTYP,PKG,PROBLEMS,PXAPREDT,PXIMMRDAPI
  1.  ;
  1.  S PXERRTYP="INPUT_ERR"
  1.  ;
  1.  I $G(PKGNAME)="" D  Q
  1.  . S OK(0)=-3
  1.  . S OK(1)=PXERRTYP_U_U_U_U_U_"Package Name argument not defined."
  1.  I $G(SRC)="" D  Q
  1.  . S OK(0)=-3
  1.  . S OK(1)=PXERRTYP_U_U_U_U_U_"Source argument not defined."
  1.  S PKG=$$PKG2IEN^VSIT(PKGNAME)
  1.  I PKG=-1 D  Q
  1.  . S OK(0)=-3
  1.  . S OK(1)=PXERRTYP_U_U_U_U_U_"Package, '"_PKGNAME_"', does not exist in the Package file (#9.4)."
  1.  ;
  1.  D DQSAVE(.PCELIST,.PXAPI,.PROBLEMS,.SRC,.PXIMMRDAPI)
  1.  I '$D(PXAPI) D  Q
  1.  . S OK(0)=-3
  1.  . S OK(1)=PXERRTYP_U_U_U_U_U_"'PCELIST' argument not valid."
  1.  ;
  1.  S PXAPREDT=1 ;Flag to allow edit of primary provider
  1.  D DATA2PCE(.OK,"PXAPI",PKG,SRC,PXAPREDT,.PXAVST)
  1.  ;
  1.  ; save immunization reading (for smallpox) in a seperate DATA2PCE call
  1.  ; as it is part of the placement visit.
  1.  I $D(PXIMMRDAPI) D
  1.  . D IMMREAD(.OK,.PXIMMRDAPI,PKG,SRC,PXAPREDT)
  1.  ;
  1.  Q
  1.  ;
  1. IMMREAD(OK,PXIMMRDAPI,PKG,SRC) ; save immunization reading (for smallpox)
  1.  ;
  1.  N PXAPREDT,PXERROR,PXERRCOUNT,PXI,PXTEMP,PXVISIT,OK2
  1.  ;
  1.  S PXERRCOUNT=+$O(OK(""),-1)
  1.  ;
  1.  S PXERROR=$G(PXIMMRDAPI("IMMUNIZATION",1,"ERROR"))
  1.  S PXVISIT=$G(PXIMMRDAPI("IMMUNIZATION",1,"VISIT"))
  1.  K PXIMMRDAPI("IMMUNIZATION",1,"ERROR")
  1.  K PXIMMRDAPI("IMMUNIZATION",1,"VISIT")
  1.  I PXERROR'="" D  Q
  1.  . I +OK(0)>0 S $P(OK(0),U,1)=-1
  1.  . S PXERRCOUNT=PXERRCOUNT+1
  1.  . S OK(PXERRCOUNT)="ERROR_IMM_READING"_U_U_U_U_U_PXERROR
  1.  I 'PXVISIT D  Q
  1.  . I +OK(0)>0 S $P(OK(0),U,1)=-1
  1.  . S PXERRCOUNT=PXERRCOUNT+1
  1.  . S OK(PXERRCOUNT)="ERROR_IMM_READING"_U_U_U_U_U_"Could not file Immunization Reading, as the Placement Visit could not be obtained."
  1.  ;
  1.  S PXAPREDT=1 ;Flag to allow edit of primary provider
  1.  D DATA2PCE(.OK2,"PXIMMRDAPI",PKG,SRC,PXAPREDT,PXVISIT)
  1.  I +OK2(0)<0,+OK(0)>0 S $P(OK(0),U,1)=$P(OK2(0),U,1)
  1.  S PXI=0
  1.  F  S PXI=$O(OK2(PXI)) Q:'PXI  D
  1.  . S PXERRCOUNT=PXERRCOUNT+1
  1.  . S PXTEMP=$G(OK2(PXI))
  1.  . S OK(PXERRCOUNT)=$P(PXTEMP,U,1)_"_IMM_READING"_U_$P(PXTEMP,U,2,99)
  1.  ;
  1.  Q
  1.  ;
  1. DQSAVE(PCELIST,PXPCEARR,PROBLEMS,SRC,PXPCEIMMRD) ;
  1.  ;
  1.  ; Processes PCELIST input array and creates a new array in a format
  1.  ; that can be passed into DATA2PCE^PXAPI.
  1.  ;
  1.  ;Input:
  1.  ;   .PCELIST - (Required) Array passed by reference.
  1.  ;              This should be in the same format as the PX SAVE DATA
  1.  ;              and ORWPCE SAVE RPCs' PCELIST input parameter.
  1.  ;  .PXPCEARR - (Required) The root of an array passed by reference
  1.  ;              that this API will populate based off the PCELIST
  1.  ;              argument. This array will be in a format that can be
  1.  ;              passed into DATA2PCE^PXAPI.
  1.  ;  .PROBLEMS - (Required) This API will populate this array with POV
  1.  ;              entries that are marked to be added to the Problem List.
  1.  ;       .SRC - (Required) The source of the data - such as 'TEXT
  1.  ;              INTEGRATION UTILITIES'. This API can possibly change the
  1.  ;              value of SRC, depending on the Health Factor (HF) values
  1.  ;              contained in PCELIST.
  1.  ;.PXPCEIMMRD - (Required) The root of an array passed by reference
  1.  ;              that this API will populate based off the PCELIST argument.
  1.  ;              It will only be populated if there is an immunization
  1.  ;              reading. This array will be in a format that can be passed
  1.  ;              into DATA2PCE^PXAPI.
  1.  ;
  1.  ;
  1.  D DQSAVE^PXRPC1(.PCELIST,.PXPCEARR,.PROBLEMS,.SRC,.PXPCEIMMRD)
  1.  Q
  1.  ;
  1.  ;
  1. DATA2PCE(OK,PXPCEARR,PKG,SRC,PXAPREDT,PXAVST) ;
  1.  N PXERROR,PXERRPROB
  1.  I '($D(PXAVST)#2) S PXAVST=""
  1.  S OK(0)=$$DATA2PCE^PXAI(PXPCEARR,PKG,SRC,.PXAVST,"",0,.PXERROR,PXAPREDT,.PXERRPROB)
  1.  S OK(0)=OK(0)_U_$G(PXAVST)
  1.  D ERROR(.OK,.PXERROR,.PXERRPROB)
  1.  ;
  1.  Q
  1.  ;
  1. ERROR(PXRET,PXERROR,PXERRPROB) ; Return errors
  1.  ;
  1.  N PXERRCOUNT,PXERRTYP,PXFIELD,PXFILE,PXIEN,PXMSG,PXNODE,PXNUM,PXSUB
  1.  ;
  1.  I '$D(PXERRPROB),'$D(PXERROR) Q
  1.  S PXERRCOUNT=0
  1.  ;
  1.  S PXNODE="PXERROR"
  1.  S PXERRTYP="ERROR_FILING"
  1.  F  S PXNODE=$Q(@PXNODE) Q:PXNODE=""  D
  1.  . S PXFILE=$QS(PXNODE,1)
  1.  . S PXNUM=$QS(PXNODE,2)
  1.  . S PXIEN=$QS(PXNODE,3)
  1.  . S PXFIELD=$QS(PXNODE,4)
  1.  . S PXSUB=$QS(PXNODE,5)
  1.  . I PXSUB'="" S PXFIELD=PXFIELD_","_PXSUB
  1.  . S PXMSG=$G(@PXNODE)
  1.  . S PXERRCOUNT=PXERRCOUNT+1
  1.  . S PXRET(PXERRCOUNT)=PXERRTYP_U_PXFILE_U_PXNUM_U_PXIEN_U_PXFIELD_U_PXMSG
  1.  ;
  1.  S PXNODE="PXERRPROB"
  1.  F  S PXNODE=$Q(@PXNODE) Q:PXNODE=""  D
  1.  . S PXERRTYP=$QS(PXNODE,3)
  1.  . S PXFILE=$QS(PXNODE,4)
  1.  . S PXFIELD=$QS(PXNODE,5)
  1.  . S PXNUM=$QS(PXNODE,6)
  1.  . S PXMSG=$G(@PXNODE)
  1.  . I PXFILE="PX/DL",PXERRTYP="ERROR4" D
  1.  . . S PXNUM=PXFIELD
  1.  . . S PXFIELD=""
  1.  . I PXFILE="ENCOUNTER",PXERRTYP="WARNING3" D
  1.  . . S PXFIELD=PXNUM
  1.  . . S PXNUM=1
  1.  . S PXERRCOUNT=PXERRCOUNT+1
  1.  . S PXRET(PXERRCOUNT)=PXERRTYP_U_PXFILE_U_PXNUM_U_U_PXFIELD_U_PXMSG
  1.  ;
  1.  Q
  1.  ;
  1. IMMSRC(IMMIS) ; Returns Event Info Source IEN
  1.  N IMMISHL,IMMISIEN,X
  1.  S IMMISHL=$P(IMMIS,";",1)
  1.  S IMMISIEN=$P(IMMIS,";",2)
  1.  ; Look up the value in the "H" Cross-reference
  1.  I 'IMMISIEN D
  1.  . S IMMISIEN=$$FIND1^DIC(920.1,,,IMMISHL,"H",,"IMMISERR")
  1.  Q IMMISIEN
  1.  ;
  1. IMMROUTE(IMMRT) ; Returns Route IEN
  1.  N IMMRTHL,IMMRTIEN,IMMRTNM,X
  1.  S IMMRTNM=$P(IMMRT,";",1)
  1.  S IMMRTHL=$P(IMMRT,";",2)
  1.  S IMMRTIEN=$P(IMMRT,";",3)
  1.  I 'IMMRTIEN,IMMRTHL'="" D
  1.  . S IMMRTIEN=$$FIND1^DIC(920.2,,,IMMRTHL,"H",,"IMMRTERR")
  1.  I 'IMMRTIEN,IMMRTNM'="" D
  1.  . S IMMRTIEN=$$FIND1^DIC(920.2,,,IMMRTNM,"B",,"IMMRTERR")
  1.  Q IMMRTIEN
  1.  ;
  1. IMMLOC(IMMAL) ; Returns Anatomic Location IEN
  1.  N IMMALHL,IMMALIEN,IMMALNM,X
  1.  S IMMALNM=$P(IMMAL,";",1)
  1.  S IMMALHL=$P(IMMAL,";",2)
  1.  S IMMALIEN=$P(IMMAL,";",3)
  1.  I 'IMMALIEN,IMMALHL'="" D
  1.  . S IMMALIEN=$$FIND1^DIC(920.3,,,IMMALHL,"B",,"IMMALERR")
  1.  I 'IMMALIEN,IMMALNM'="" D
  1.  . S IMMALIEN=$$FIND1^DIC(920.3,,,IMMALNM,"B",,"IMMALERR")
  1.  Q IMMALIEN
  1.  ;
  1. IMMLOT(IMMLOT,IMMMANUF,IMMEXPDT) ; Returns Lot_IEN^Comment
  1.  N IMMCOMM,IMMLOTIEN,IMMLOTNM,X
  1.  S IMMLOTNM=$P(IMMLOT,";",1)
  1.  S IMMLOTIEN=$P(IMMLOT,";",2)
  1.  ;
  1.  I IMMLOTIEN Q IMMLOTIEN
  1.  ;
  1.  ; If the Lot Number, Manufacturer and Expiration Date are all specified,
  1.  ; then find an entry matching all three values in File 9999999.41 (IMMUNIZATION LOT)
  1.  ; If we don't find a match, then add the fields to the Comment.
  1.  ; For now, we will not receive the Expiration Date from Walgreens, so we always update the Comment.
  1.  S IMMCOMM=""
  1.  S:IMMLOTNM'="" IMMCOMM=IMMCOMM_$S(IMMCOMM="":"",1:" ")_"Lot#: "_IMMLOTNM
  1.  S:IMMMANUF'="" IMMCOMM=IMMCOMM_$S(IMMCOMM="":"",1:" ")_"Mfr: "_IMMMANUF
  1.  S:IMMEXPDT'="" IMMCOMM=IMMCOMM_$S(IMMCOMM="":"",1:" ")_"Expiration Date: "_IMMEXPDT
  1.  Q "^"_IMMCOMM
  1.  ;
  1. IMMVIS(IMMVISMULT,PXPCEARR,IMM) ; Sets PXPCEARR's VIS multiple
  1.  N IMMVIS,IMMVISDT,IMMVISENTRY,PXSEQ,PXX,X
  1.  S PXSEQ=0
  1.  F PXX=1:1:$L(IMMVISMULT,";") D
  1.  . S IMMVISENTRY=$$TRIM^XLFSTR($P(IMMVISMULT,";",PXX))
  1.  . S IMMVIS=$P(IMMVISENTRY,"/",1)
  1.  . I 'IMMVIS Q
  1.  . S IMMVISDT=$P(IMMVISENTRY,"/",2)
  1.  . I IMMVISDT S IMMVIS=IMMVIS_U_IMMVISDT
  1.  . S PXSEQ=PXSEQ+1
  1.  . S PXPCEARR("IMMUNIZATION",IMM,"VIS",PXSEQ,0)=IMMVIS
  1.  Q
  1.  ;
  1. IMMRMRKS(IMMREMARKS,IMMNUM,REMARK) ; Sets REMARK array
  1.  N PXEND,PXSTART,PXX,X
  1.  S PXSTART=$P(IMMREMARKS,";",1)
  1.  S PXEND=$P(IMMREMARKS,";",2)
  1.  I ('PXSTART)!('PXEND)!(PXEND<PXSTART) Q
  1.  F PXX=PXSTART:1:PXEND D
  1.  . S REMARK(PXX)="IMMUNIZATION^"_IMMNUM
  1.  Q
  1.  ;
  1. IMMDSG(IMMDSG) ;
  1.  N IMMDOSE,IMMUNIT,IMMUNITIEN,IMMDOSEV,IMMUNERR,X
  1.  S IMMDSG=$$TRIM^XLFSTR(IMMDSG)
  1.  I IMMDSG="" Q ""
  1.  S IMMDOSE=$P(IMMDSG,";",1)
  1.  S IMMUNIT=$P(IMMDSG,";",2)
  1.  S IMMUNITIEN=$P(IMMDSG,";",3)
  1.  I IMMDSG[" ",IMMDSG'[";" D  ;Remove this DO block when VLER DAS starts using ";" between dose and units
  1.  . S IMMDOSE=$P(IMMDSG," ",1)
  1.  . S IMMUNIT=$P(IMMDSG," ",2)
  1.  ;
  1.  I IMMDOSE="" Q ""
  1.  ;
  1.  I IMMUNIT'="",'IMMUNITIEN D
  1.  . N UCUMDATA
  1.  . D UCUMDATA^LEXMUCUM(IMMUNIT,.UCUMDATA)  ; ICR 6225
  1.  . S IMMUNITIEN=$O(UCUMDATA(0))
  1.  D CHK^DIE(9000010.11,1312,,IMMDOSE,.IMMDOSEV,"IMMUNERR")
  1.  I IMMUNITIEN,IMMDOSEV'="^" Q IMMDOSEV_U_IMMUNITIEN
  1.  ;
  1.  Q U_U_"Dosage: "_IMMDOSE_" "_IMMUNIT