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

ORQQPX.m

Go to the documentation of this file.
  1. ORQQPX ; SLC/JM - PCE and Reminder routines ;10/16/2019
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,184,187,190,226,377**;Dec 17, 1997;Build 582
  1. Q
  1. ;
  1. IMMLIST(ORY,ORPT,ORSORT) ;return pt's immunization list:
  1. ;id^name^date/time^reaction^inverse d/t
  1. I $L($T(IMMUN^PXRHS03))<1 S ORY(1)="^Immunizations not available." Q
  1. K ^TMP("PXI",$J)
  1. D IMMUN^PXRHS03(ORPT,$G(ORSORT))
  1. N ORI,IMM,IVDT,IEN,X
  1. S ORI=0,IMM="",IVDT="",IEN=0
  1. F S IMM=$O(^TMP("PXI",$J,IMM)) Q:IMM="" D
  1. .F S IVDT=$O(^TMP("PXI",$J,IMM,IVDT)) Q:IVDT="" D
  1. ..F S IEN=$O(^TMP("PXI",$J,IMM,IVDT,IEN)) Q:IEN<1 D
  1. ...S ORI=ORI+1,X=$G(^TMP("PXI",$J,IMM,IVDT,IEN,0)) Q:'$L(X)
  1. ...S ORY(ORI)=IEN_U_IMM_U_$P(X,U,3)
  1. ...I $P(X,U,7)=1 S ORY(ORI)=ORY(ORI)_U_$P(X,U,6)_U_IVDT
  1. ...E S ORY(ORI)=ORY(ORI)_U_U_IVDT
  1. S:+$G(ORY(1))<1 ORY(1)="^No immunizations found.^2900101^^9999999"
  1. K ^TMP("PXI",$J)
  1. Q
  1. ;
  1. DETAIL(ORY,IMM) ; return detailed information for an immunization
  1. S ORY(1)="Detailed information on immunizations is not available."
  1. Q
  1. ;
  1. REMIND(ORY,ORPT) ;return pt's currently due PCE clinical reminders
  1. ; in the format file 811.9 ien^reminder print name^date due^last occur.
  1. N ORTMPLST,ORI,ORJ,ORIEN,ORTXT,ORX,ORLASTDT,ORDUEDT,ORLOC
  1. S ORJ=0
  1. ;
  1. ;get patient's location flag (INPATIENT ONLY - outpt locations cannot be
  1. ;reliably determined, and many simultaneous outpt locations can occur):
  1. I +$G(ORPT)>0 D
  1. .N DFN S DFN=ORPT,VA200="" D OERR^VADPT
  1. .I +$G(VAIN(4))>0 S ORLOC=+$G(^DIC(42,+$G(VAIN(4)),44))
  1. .K VA200,VAIN
  1. ;
  1. D REMLIST(.ORTMPLST,$G(ORLOC))
  1. ;D GETLST^XPAR(.ORTMPLST,"USR^LOC.`"_$G(ORLOC)_"^SRV.`"_+$G(ORSRV)_"^DIV^SYS^PKG","ORQQPX SEARCH ITEMS","Q",.ORERR)
  1. ;I ORERR>0 S ORY(1)=U_"Error: "_$P(ORERR,U,2) Q
  1. D AVAL^PXRMRPCA(.ORTMPLST,2)
  1. Q
  1. ;
  1. REMDET(ORY,ORPT,ORIEN) ;return detail for a pt's clinical reminder
  1. ; ORY - return array
  1. ; ORPT - patient DFN
  1. ; ORIEN - clinical reminder (811.9 ien)
  1. K ^TMP("PXRHM",$J)
  1. D MAIN^PXRM(ORPT,ORIEN,5) ; 5 returns all reminder info
  1. N CR,I,J,ORTXT S I=1
  1. S ORTXT="",ORTXT=$O(^TMP("PXRHM",$J,ORIEN,ORTXT)) Q:ORTXT="" D
  1. .S J=0 F S J=$O(^TMP("PXRHM",$J,ORIEN,ORTXT,"TXT",J)) Q:J="" D
  1. ..S ORY(I)=^TMP("PXRHM",$J,ORIEN,ORTXT,"TXT",J),I=I+1
  1. K ^TMP("PXRHM",$J)
  1. Q
  1. ;
  1. NEWACTIV(ORY) ;Return true if Interactive Reminders are active
  1. S ORY=0
  1. I $T(APPL^PXRMRPCA)'="",+$G(DUZ) D
  1. . N SRV
  1. . S SRV=$$GET1^DIQ(200,DUZ,29,"I")
  1. . S ORY=$$GET^XPAR(DUZ_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM GUI REMINDERS ACTIVE",1,"Q")
  1. . I +ORY S ORY=1
  1. . E S ORY=0
  1. Q
  1. ;
  1. HISTLOC(LST) ;Returns a list of historical locations
  1. N IDX,PTR,LINE,NAME
  1. K ^TMP("OR",$J,"LOC")
  1. S LST=$NA(^TMP("OR",$J,"LOC"))
  1. S (LINE,IDX)=0
  1. F S IDX=$O(^AUTTLOC(IDX)) Q:'IDX D
  1. .S PTR=+$G(^AUTTLOC(IDX,0))
  1. .I +PTR D
  1. ..S NAME=$$GET1^DIQ(4,PTR,.01,"I")
  1. ..I NAME'="" D
  1. ...S LINE=LINE+1
  1. ...S ^TMP("OR",$J,"LOC",LINE)=PTR_U_NAME
  1. Q
  1. ;
  1. GETFLDRS(ORFLDRS) ;Return Visible Reminder Folders
  1. ; Codes: D=Due, A=Applicable, N=Not Applicable, E=Evaluated, O=Other
  1. N SRV,ORERR,ORTMP
  1. S SRV=$$GET1^DIQ(200,DUZ,29,"I")
  1. D GETLST^XPAR(.ORTMP,"USR^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORQQPX REMINDER FOLDERS","Q",.ORERR)
  1. I +ORTMP S ORFLDRS=$P($G(ORTMP(1)),U,2)
  1. E S ORFLDRS="DAO"
  1. Q
  1. ;
  1. SETFLDRS(ORY,ORFLDRS) ;Sets Visible Reminder Folders for the current user
  1. N ORERR
  1. D EN^XPAR(DUZ_";VA(200,","ORQQPX REMINDER FOLDERS",1,ORFLDRS,.ORERR)
  1. S ORY=1
  1. Q
  1. ;
  1. GETDEFOL(ORDEFLOC) ;Return Default Outside Locations
  1. N SRV,ORERR
  1. S SRV=$$GET1^DIQ(200,DUZ,29,"I")
  1. D GETLST^XPAR(.ORDEFLOC,"USR^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORQQPX DEFAULT LOCATIONS","Q",.ORERR)
  1. Q
  1. ;
  1. INSCURS(ORY) ; Returns status of ORQQPX REMINDER TEXT AT CURSOR
  1. N SRV,ORERR,ORTMP
  1. S ORY=0,SRV=$$GET1^DIQ(200,DUZ,29,"I")
  1. D GETLST^XPAR(.ORTMP,"USR^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORQQPX REMINDER TEXT AT CURSOR","Q",.ORERR)
  1. I +ORTMP S ORY=$P($G(ORTMP(1)),U,2)
  1. Q
  1. ;
  1. NEWCVOK(ORY) ; Returns status of
  1. N SRV,ORERR,ORTMP
  1. S ORY=0,SRV=$$GET1^DIQ(200,DUZ,29,"I")
  1. D GETLST^XPAR(.ORTMP,"USR^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORQQPX NEW REMINDER PARAMS","Q",.ORERR)
  1. I +ORTMP S ORY=$P($G(ORTMP(1)),U,2)
  1. Q
  1. ;
  1. ADDNAME(ORX) ; Add Reminder or Category Name as 3rd piece
  1. N CAT,IEN
  1. S CAT=$E($P(ORX,U,2),2)
  1. S IEN=$E($P(ORX,U,2),3,99)
  1. I +IEN D
  1. .I CAT="R" S $P(ORX,U,3)=$P($G(^PXD(811.9,IEN,0)),U,3)
  1. .I CAT="C" S $P(ORX,U,3)=$P($G(^PXRMD(811.7,IEN,0)),U)
  1. Q ORX
  1. ;
  1. REMACCUM(ORY,LVL,TYP,SORT,CLASS) ; Accumulates ORTMP into ORY
  1. ; Format of entries in ORQQPX COVER SHEET REMINDERS:
  1. ; L:Lock;R:Remove;N:Normal / C:Category;R:Reminder / Cat or Rem IEN
  1. N IDX,I,J,K,M,FOUND,ORERR,ORTMP,FLAG,IEN
  1. N FFLAG,FIEN,OUT,P2,ADD,DOADD,CODE
  1. I LVL="CLASS" D I 1
  1. .N ORLST,ORCLS,ORCLSPRM,ORWP
  1. .S ORCLSPRM="ORQQPX COVER SHEET REM CLASSES"
  1. .D GETLST^XPAR(.ORLST,"SYS",ORCLSPRM,"Q",.ORERR)
  1. .S I=0,M=0,CLASS=$G(CLASS)
  1. .F S I=$O(ORLST(I)) Q:'I D
  1. ..S ORCLS=$P(ORLST(I),U,1)
  1. ..I +CLASS S ADD=(ORCLS=+CLASS) I 1
  1. ..E S ADD=$$ISA^USRLM(DUZ,ORCLS,.ORERR)
  1. ..I +ADD D
  1. ...D GETWP^XPAR(.ORWP,"SYS",ORCLSPRM,ORCLS,.ORERR)
  1. ...S K=0
  1. ...F S K=$O(ORWP(K)) Q:'K D
  1. ....S M=M+1
  1. ....S J=$P(ORWP(K,0),";",1)
  1. ....S ORTMP(M)=J_U_$P(ORWP(K,0),";",2)
  1. E D GETLST^XPAR(.ORTMP,LVL,"ORQQPX COVER SHEET REMINDERS",TYP,.ORERR)
  1. S I=0,IDX=$O(ORY(999999),-1)+1,ADD=(SORT="")
  1. F S I=$O(ORTMP(I)) Q:'I D
  1. .S (FOUND,J)=0,P2=$P(ORTMP(I),U,2)
  1. .S FLAG=$E(P2),IEN=$E(P2,2,999)
  1. .I ADD S DOADD=1
  1. .E D
  1. ..S DOADD=0
  1. ..F S J=$O(ORY(J)) Q:'J D Q:FOUND
  1. ...S P2=$P(ORY(J),U,2)
  1. ...S FIEN=$E(P2,2,999)
  1. ...I FIEN=IEN S FOUND=J,FFLAG=$E(P2)
  1. ..I FOUND D I 1
  1. ...I FLAG="R",FFLAG'="L" K ORY(FOUND)
  1. ...I FLAG'=FFLAG,(FLAG_FFLAG)["L" S $E(P2)="L",$P(ORY(FOUND),U,2)=P2
  1. ..E I (FLAG'="R") S DOADD=1
  1. .I DOADD D
  1. ..S OUT(IDX)=ORTMP(I)
  1. ..S $P(OUT(IDX),U)=$P(OUT(IDX),U)_SORT
  1. ..I SORT="" S OUT(IDX)=$$ADDNAME(OUT(IDX))
  1. ..S IDX=IDX+1
  1. M ORY=OUT
  1. Q
  1. ;
  1. ADDREM(ORY,IDX,IEN) ; Add Reminder to ORY list
  1. I $D(ORY("B",IEN)) Q ; See if it's in the list
  1. I '$D(^PXD(811.9,IEN)) Q ; Check if Exists
  1. I $P($G(^PXD(811.9,IEN,0)),U,6)'="" Q ; Check if Active
  1. ;Check to see if the reminder is assigned to CPRS
  1. N USAGE
  1. S USAGE=$P($G(^PXD(811.9,IEN,100)),U,4)
  1. ;If the Usage is List or Order Check skip it.
  1. I (USAGE["L")!(USAGE["O") Q
  1. ;If the Usage is not C or * skip it.
  1. I USAGE'["C",USAGE'="*" Q
  1. S ORY(IDX)=IDX_U_IEN
  1. S ORY("B",IEN)=""
  1. Q
  1. ;
  1. ADDCAT(ORY,IDX,IEN) ; Add Category Reminders to ORY list
  1. N ORREM,I,IDX2,NREM
  1. D CATREM^PXRMAPI0(IEN,.ORREM)
  1. S I=0
  1. F S I=$O(ORREM(I)) Q:'I D
  1. . S IDX2="00000"_I
  1. . S IDX2=$E(IDX2,$L(IDX2)-5,99)
  1. . D ADDREM(.ORY,+(IDX_"."_IDX2),$P(ORREM(I),U,1))
  1. Q
  1. ;
  1. REMLIST(ORY,LOC) ;Returns a list of all cover sheet reminders
  1. N SRV,I,J,ORLST,CODE,IDX,IEN,NEWP
  1. S SRV=$$GET1^DIQ(200,DUZ,29,"I")
  1. D NEWCVOK(.NEWP)
  1. I 'NEWP D Q
  1. . N OLDLIST,RESULT
  1. . D GETLST^XPAR(.OLDLIST,"USR^LOC.`"_$G(LOC)_"^SRV.`"_+$G(SRV)_"^DIV^SYS^PKG","ORQQPX SEARCH ITEMS","Q",.ORERR) Q
  1. . S I=0
  1. . F S I=$O(OLDLIST(I)) Q:'I D
  1. .. S IDX=$P(OLDLIST(I),U,1)
  1. .. F Q:'$D(RESULT(IDX)) S IDX=IDX+1
  1. .. S IEN=$P(OLDLIST(I),U,2)
  1. .. D ADDREM(.RESULT,IDX,IEN)
  1. . K RESULT("B")
  1. ;
  1. D REMACCUM(.ORLST,"PKG","Q",1000)
  1. D REMACCUM(.ORLST,"SYS","Q",2000)
  1. D REMACCUM(.ORLST,"DIV","Q",3000)
  1. I +SRV D REMACCUM(.ORLST,"SRV.`"_+$G(SRV),"Q",4000)
  1. I +LOC D REMACCUM(.ORLST,"LOC.`"_+$G(LOC),"Q",5000)
  1. D REMACCUM(.ORLST,"CLASS","Q",6000)
  1. D REMACCUM(.ORLST,"USR","Q",7000)
  1. S I=0
  1. F S I=$O(ORLST(I)) Q:'I D
  1. .S IDX=$P(ORLST(I),U,1)
  1. .F Q:'$D(ORY(IDX)) S IDX=IDX+1
  1. .S CODE=$E($P(ORLST(I),U,2),2)
  1. .S IEN=$E($P(ORLST(I),U,2),3,999)
  1. .I CODE="R" D ADDREM(.ORY,IDX,IEN)
  1. .I CODE="C" D ADDCAT(.ORY,IDX,IEN)
  1. K ORY("B")
  1. Q
  1. ;
  1. LVREMLST(ORY,LVL,CLASS) ;Returns cover sheet reminders at a specified level
  1. D REMACCUM(.ORY,LVL,"Q","",$G(CLASS))
  1. Q
  1. ;
  1. SAVELVL(ORY,LVL,CLASS,DATA) ;Save cover sheet reminders at a specified level
  1. N ORERR,PARAM,I
  1. I LVL="CLASS" D I 1
  1. .S PARAM="ORQQPX COVER SHEET REM CLASSES"
  1. .S LVL="SYS"
  1. .D DEL^XPAR(LVL,PARAM,"`"_CLASS,.ORERR)
  1. .D EN^XPAR(LVL,PARAM,"`"_CLASS,.DATA,.ORERR)
  1. E D
  1. .S PARAM="ORQQPX COVER SHEET REMINDERS"
  1. .D NDEL^XPAR(LVL,PARAM,.ORERR)
  1. .S I=0
  1. .F S I=$O(DATA(I)) Q:'I D
  1. ..D EN^XPAR(LVL,PARAM,$P(DATA(I),U,1),$P(DATA(I),U,2),.ORERR)
  1. S ORY=1
  1. Q
  1. ;
  1. GETLIST(ORY,ORLOC) ;Returns a list of all cover sheet reminders
  1. N I
  1. D REMLIST(.ORY,$G(ORLOC))
  1. S I=0
  1. F S I=$O(ORY(I)) Q:'I D
  1. .S ORY(I)=$P(ORY(I),U,2)
  1. Q
  1. ;
  1. EVALCOVR(ORY,ORPT,ORLOC) ; Evaluate Cover Sheet Reminders
  1. N ORTMP
  1. D GETLIST(.ORTMP,$G(ORLOC))
  1. D ALIST^ORQQPXRM(.ORY,ORPT,.ORTMP)
  1. Q
  1. ;