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

PXRMRPCC.m

Go to the documentation of this file.
  1. PXRMRPCC ;SLC/PJH - PXRM REMINDER DIALOG ;01/11/2022
  1. ;;2.0;CLINICAL REMINDERS;**6,45,65**;Feb 04, 2005;Build 438
  1. ;
  1. ; API ICR
  1. ;$$GET^XPAR 2263
  1. ;SHOWALL^YTQPXRM5 5056
  1. ;SAVECR^YTQPXRM4 4463
  1. ;NEW^WVRPCNO 4104
  1. ;
  1. ACTIVE(ORY,ORREM) ;Check if active dialog exist for reminders
  1. ;
  1. ; input parameter ORREM is array of reminder ien [.01#811.9]
  1. N DDIS,DIEN,OCNT,RIEN,RSTA
  1. S OCNT=0,RIEN=0
  1. ;Get reminder ien from array
  1. F S RIEN=$O(ORREM(RIEN)) Q:'RIEN D
  1. .;Dialog ien for reminder
  1. .S DIEN=$P($G(^PXD(811.9,RIEN,51)),U),RSTA=0
  1. .;Dialog status
  1. .I DIEN S DDIS=$P($G(^PXRMD(801.41,DIEN,0)),U,3)
  1. .;If dialog and dialog not disabled
  1. .I DIEN,+DDIS=0 S RSTA=1
  1. .;Return reminder and if active dialog exists
  1. .S OCNT=OCNT+1,ORY(OCNT)=RIEN_U_RSTA
  1. Q
  1. ;
  1. ;
  1. DIALOG(ORY,ORREM,DFN,VISITID) ;Load reminder dialog associated with the reminder
  1. ;
  1. ; input parameter ORREM - reminder ien [.01,#811.9]
  1. ;
  1. S RIEN=ORREM
  1. N DATA,DIEN
  1. S DIEN=$G(^PXD(811.9,ORREM,51))
  1. ;
  1. ;Quit if no dialog for this reminder
  1. I 'DIEN S ORY(1)="-1^no dialog for this reminder" Q
  1. ;
  1. ;Check if a reminder dialog and enabled
  1. S DATA=$G(^PXRMD(801.41,DIEN,0))
  1. ;
  1. I $P(DATA,U,4)'="R" S ORY(1)="-1^reminder dialog invalid" Q
  1. ;
  1. I $P(DATA,U,3) S ORY(1)="-1^reminder dialog disabled" Q
  1. ;
  1. ;Load dialog lines into local array
  1. S ORY(0)=0_U_+$P($G(^PXRMD(801.41,DIEN,0)),U,17)
  1. D LOAD^PXRMDLL(DIEN,$G(DFN),VISITID)
  1. Q
  1. ;
  1. HDR(ORY,ORLOC) ;Progress Note Header by location/service/user
  1. N ORSRV,PASS
  1. ;S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
  1. S ORSRV=$$GET1^DIQ(200,DUZ,29,"I")
  1. S PASS=DUZ_";VA(200,"
  1. I +$G(ORLOC) S PASS=PASS_"^LOC.`"_ORLOC
  1. I ORSRV>0 S PASS=PASS_"^SRV.`"_+$G(ORSRV)
  1. S ORY=$$GET^XPAR(PASS_"^DIV^SYS^PKG","PXRM PROGRESS NOTE HEADERS",1,"Q")
  1. Q
  1. ;
  1. PROMPT(ORY,ORDLG,ORDCUR,ORFTYP,ORIEN,NDATA) ;Load additional prompts for a dialog element
  1. ;
  1. ; input parameters
  1. ;
  1. ; ORDLG - dialog element ien [.01,#801.41]
  1. ; ORDCUR - 0 = current, 1 = Historical for taxonomies only
  1. ; ORFTYP - finding type (CPT/POV) for taxonomies only
  1. ; ORIEN - dialog ien [.01,#801.41]
  1. ;
  1. ; These fields can be found in the output array of DIALOG^PXRMRPCC
  1. ;
  1. D LOAD^PXRMDLLA(ORDLG,ORDCUR,$G(ORFTYP),$G(ORIEN),$G(NDATA))
  1. Q
  1. ;
  1. RES(ORY,ORREM) ; Reminder Resources/Inquiry
  1. ;
  1. ; input parameter ORREM - reminder ien [.01,#811.9]
  1. ;
  1. D REMVAR^PXRMINQ(.ORY,ORREM)
  1. Q
  1. ;
  1. MH(ORY,OTEST) ; Mental Health dialog
  1. ;
  1. ; Input mental health instrument NAME
  1. ;
  1. K ^TMP($J,"YSQU")
  1. N ARRAY,CNT,CNT1,FNODE,FSUB,IC,NODE,OCNT,SUB,YS
  1. S YS("CODE")=OTEST D SHOWALL^YTQPXRM5(.ARRAY,.YS)
  1. S OCNT=0,CNT=0
  1. S SUB="ARRAY",OCNT=0
  1. F S SUB=$Q(@SUB) Q:SUB="" D
  1. .S FSUB=$P($P(SUB,"(",2),")"),FNODE=""
  1. .F IC=1:1 S NODE=$P(FSUB,",",IC) Q:NODE="" D
  1. ..I $E(NODE)="""" S NODE=$P(NODE,"""",2)
  1. ..S $P(FNODE,";",IC)=NODE
  1. .Q:FNODE=""
  1. .S OCNT=OCNT+1,ORY(OCNT)=FNODE_U_@SUB
  1. Q
  1. ;
  1. MHR(ORY,RESULT,ORES) ; Mental Health score and P/N text
  1. ;
  1. ; Input MH result IEN and mental health instrument response
  1. ;
  1. D START^PXRMDLR(.ORY,RESULT,.ORES)
  1. ;
  1. Q
  1. ;
  1. MHS(ORY,YS) ; Mental Health save response
  1. ;
  1. ; Input mental health instrument response
  1. N ANS,ARRAY,X
  1. S ANS=$G(YS("R1")) K YS("R1")
  1. S YS("ADATE")=YS("ADATE")_"."_$P($$NOW^XLFDT,".",2)
  1. F X=1:1:$L(ANS) I $E(ANS,X)'="X" S YS(X)=X_U_$E(ANS,X)
  1. D SAVECR^YTQPXRM4(.ARRAY,.YS)
  1. Q
  1. ;
  1. MST(ORY,DFN,DGMSTDT,DGMSTSC,DGMSTPR,FTYP,FIEN,RESULT) ; File MST status
  1. ;This is obsolete and can be removed when the GUI is changed not
  1. ;to use it.
  1. Q
  1. ;
  1. PROMPTVL(ORY,VALUE,DIEN,OVALUE,PAT) ; Calculate prompt value
  1. N ACT,DONE,FUNC,NODE,CNT,FUNC,INPUTS,LINK,NUM,RESULT,RTN,SUB,TEMP,VAL
  1. S CNT=0,DONE=0 F S CNT=$O(^PXRMD(801.41,DIEN,10,CNT)) Q:CNT'>0!(DONE=1) D
  1. .S LINK=$P($G(^PXRMD(801.41,DIEN,10,CNT,"LINK")),U) Q:LINK'>0
  1. .S NODE=^PXRMD(801.48,LINK,0)
  1. .S FUNC=$P($G(NODE),U,4) I FUNC'>0 Q
  1. .S ACT=$P(NODE,U,5) I ACT="" Q
  1. .;build additional inputs
  1. .S NUM=0 F S NUM=$O(^PXRMD(801.48,LINK,2,NUM)) Q:NUM'>0 D
  1. ..S NODE=$G(^PXRMD(801.48,LINK,2,NUM,0)),SUB=$P(NODE,U),VAL=$P(NODE,U,2) Q:SUB="" Q:VAL=""
  1. ..S INPUTS(SUB)=VAL
  1. .;AGP do we need to still check item and prompt value??
  1. .;S RESULT="",FUNC=$P($G(NODE),U,4) I FUNC>0 D REMFUN(.RESULT,FUNC,PAT,VALUE,OVALUE)
  1. .S RESULT="",RTN=$P($G(^PXRMD(801.47,FUNC,0)),U,2,3) Q:$P(RTN,U)="" Q:$P(RTN,U,2)=""
  1. .S TEMP="S RET=$$"_RTN_"(.RESULT,PAT,VALUE,OVALUE,.INPUTS)"
  1. .X TEMP
  1. .S DONE=1
  1. .I FUNC>0,RESULT="" Q
  1. .;S ACT=$P(NODE,U,5) I ACT="" Q
  1. .S ORY=$S(ACT="C":"CHECKED",ACT="S":"SUPPRESS",ACT="R":"REQUIRED",ACT="V":RESULT,ACT="UC":"UNCHECKED",ACT="US":"UNSUPPRESS",1:"")
  1. .;S NODE=$G(^PXRMD(801.41,DIEN,10,CNT,0)) Q:LITEM'=$P(NODE,U,10) Q:LTYPE'=$P(NODE,U,11)
  1. .;S FUNC=$G(^PXRMD(801.41,DIEN,10,CNT,1)) Q:FUNC=""
  1. .;X FUNC S:$G(RESULT)'="" ORY=RESULT
  1. Q
  1. ;
  1. REMFUN(RESULT,IEN,PAT,VALUE,OVALUE) ;
  1. N INPUTS,NODE,NUM,RTN,RET,SUB,VAL,TEMP
  1. S RTN=$P($G(^PXRMD(801.47,IEN,0)),U,2,3) Q:$P(RTN,U)="" Q:$P(RTN,U,2)=""
  1. S NUM=0 F S NUM=$O(^PXRMD(801.48,IEN,2,NUM)) Q:NUM'>0 D
  1. .S NODE=$G(^PXRMD(801.48,IEN,2,NUM,0)),SUB=$P(NODE,U),VAL=$P(NODE,U,2) Q:SEQ="" Q:VAL=""
  1. .S INPUTS(SUB)=VAL
  1. S TEMP="S RET=$$"_RTN_"(.RESULT,PAT,VALUE,OVALUE,.INPUTS)"
  1. X TEMP
  1. Q
  1. ;
  1. WH(ORY,RESULT) ;
  1. N CNT,CNT1,CNT2,NODE,PIECNT,PUR,TYPE,TYP1,WVIEN,WVRESULT,WVNOT,WVPURIEN
  1. N PRINT
  1. K ^TMP("WV RPT",$J)
  1. I '$D(RESULT) Q
  1. S (CNT2,WVPURIEN,PUR)=0
  1. S CNT=0 F S CNT=$O(RESULT(CNT)) Q:CNT="" D
  1. . I $P($G(RESULT(CNT)),U)["WHIEN" D
  1. . . S CNT2=CNT2+1
  1. . . S WVIEN=$P($P($G(RESULT(CNT)),U),":",2),WVRESULT(CNT2)=$G(WVIEN)
  1. . . S WVRESULT(CNT2)=WVRESULT(CNT2)_U_$P($P($G(RESULT(CNT)),U,3),":",2)
  1. . I $P($G(RESULT(CNT)),U)["WHPur" D
  1. . . S NODE=$G(RESULT(CNT)),PUR=$P($P($G(NODE),U),":",2)
  1. . . S CNT1=1,TYPE=$P($G(NODE),U,2)
  1. . . I TYPE'[":" D
  1. ...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$P($G(NODE),U,2)_U_$P($G(NODE),U,3)_U_$P($P($G(NODE),U,4),":",2)
  1. ..I TYPE[":" D
  1. ...S PIECNT=0
  1. ...F X=1:1:$L(TYPE) I $E(TYPE,X)=":" S PIECNT=PIECNT+1 I PIECNT>0 D
  1. ....S PRINT=""
  1. ....S TYP1=$P($G(TYPE),":",PIECNT)
  1. ....I TYP1="L" S PRINT=$P($G(NODE),U,3)
  1. ....S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2),CNT1=CNT1+1
  1. ...S PIECNT=PIECNT+1
  1. ...S PRINT=""
  1. ...S TYP1=$P($G(TYPE),":",PIECNT)
  1. ...I TYP1="L" S PRINT=$P($G(NODE),U,3)
  1. ...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2)
  1. K WHMUFIND,WHFIND,WHNAME
  1. D NEW^WVRPCNO(.WVRESULT,.WVNOT)
  1. Q
  1. ;