PXRMRPCC ;SLC/PJH - PXRM REMINDER DIALOG ;11/26/2007
;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
;
ACTIVE(ORY,ORREM) ;Check if active dialog exist for reminders
;
; input parameter ORREM is array of reminder ien [.01#811.9]
N DDIS,DIEN,OCNT,RIEN,RSTA
S OCNT=0,RIEN=0
;Get reminder ien from array
F S RIEN=$O(ORREM(RIEN)) Q:'RIEN D
.;Dialog ien for reminder
.S DIEN=$P($G(^PXD(811.9,RIEN,51)),U),RSTA=0
.;Dialog status
.I DIEN S DDIS=$P($G(^PXRMD(801.41,DIEN,0)),U,3)
.;If dialog and dialog not disabled
.I DIEN,DDIS="" S RSTA=1
.;Return reminder and if active dialog exists
.S OCNT=OCNT+1,ORY(OCNT)=RIEN_U_RSTA
Q
;
;
DIALOG(ORY,ORREM,DFN) ;Load reminder dialog associated with the reminder
;
; input parameter ORREM - reminder ien [.01,#811.9]
;
S RIEN=ORREM
N DATA,DIEN
S DIEN=$G(^PXD(811.9,ORREM,51))
;
;Quit if no dialog for this reminder
I 'DIEN S ORY(1)="-1^no dialog for this reminder" Q
;
;Check if a reminder dialog and enabled
S DATA=$G(^PXRMD(801.41,DIEN,0))
;
I $P(DATA,U,4)'="R" S ORY(1)="-1^reminder dialog invalid" Q
;
I $P(DATA,U,3) S ORY(1)="-1^reminder dialog disabled" Q
;
;Load dialog lines into local array
S ORY(0)=0_U_+$P($G(^PXRMD(801.41,DIEN,0)),U,17)
D LOAD^PXRMDLL(DIEN,$G(DFN))
Q
;
HDR(ORY,ORLOC) ;Progress Note Header by location/service/user
N ORSRV,PASS
;S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
S ORSRV=$$GET1^DIQ(200,DUZ,29,"I")
S PASS=DUZ_";VA(200,"
I +$G(ORLOC) S PASS=PASS_"^LOC.`"_ORLOC
I ORSRV>0 S PASS=PASS_"^SRV.`"_+$G(ORSRV)
S ORY=$$GET^XPAR(PASS_"^DIV^SYS^PKG","PXRM PROGRESS NOTE HEADERS",1,"Q")
Q
;
PROMPT(ORY,ORDLG,ORDCUR,ORFTYP) ;Load additional prompts for a dialog element
;
; input parameters
;
; ORDLG - dialog element ien [.01,#801.41]
; ORDCUR - 0 = current, 1 = Historical for taxonomies only
; ORFTYP - finding type (CPT/POV) for taxonomies only
;
; These fields can be found in the output array of DIALOG^PXRMRPCC
;
D LOAD^PXRMDLLA(ORDLG,ORDCUR,$G(ORFTYP))
Q
;
RES(ORY,ORREM) ; Reminder Resources/Inquiry
;
; input parameter ORREM - reminder ien [.01,#811.9]
;
D REMVAR^PXRMINQ(.ORY,ORREM)
Q
;
MH(ORY,OTEST) ; Mental Health dialog
;
; Input mental health instrument NAME
;
K ^TMP($J,"YSQU")
N ARRAY,CNT,CNT1,FNODE,FSUB,IC,NODE,OCNT,SUB,YS
;DBIA #5056
S YS("CODE")=OTEST D SHOWALL^YTQPXRM5(.ARRAY,.YS)
S OCNT=0,CNT=0
S SUB="ARRAY",OCNT=0
F S SUB=$Q(@SUB) Q:SUB="" D
.S FSUB=$P($P(SUB,"(",2),")"),FNODE=""
.F IC=1:1 S NODE=$P(FSUB,",",IC) Q:NODE="" D
..I $E(NODE)="""" S NODE=$P(NODE,"""",2)
..S $P(FNODE,";",IC)=NODE
.Q:FNODE=""
.S OCNT=OCNT+1,ORY(OCNT)=FNODE_U_@SUB
Q
;
MHR(ORY,RESULT,ORES) ; Mental Health score and P/N text
;
; Input MH result IEN and mental health instrument response
;
D START^PXRMDLR(.ORY,RESULT,.ORES)
;
Q
;
MHS(ORY,YS) ; Mental Health save response
;
; Input mental health instrument response
N ANS,ARRAY,X
S ANS=$G(YS("R1")) K YS("R1")
S YS("ADATE")=YS("ADATE")_"."_$P($$NOW^XLFDT,".",2)
F X=1:1:$L(ANS) I $E(ANS,X)'="X" S YS(X)=X_U_$E(ANS,X)
;DBIA #4463
D SAVECR^YTQPXRM4(.ARRAY,.YS)
Q
;
MST(ORY,DFN,DGMSTDT,DGMSTSC,DGMSTPR,FTYP,FIEN,RESULT) ; File MST status
;This is obsolete and can be removed when the GUI is changed not
;to use it.
Q
;
WH(ORY,RESULT) ;
N CNT,CNT1,CNT2,NODE,PIECNT,PUR,TYPE,TYP1,WVIEN,WVRESULT,WVNOT,WVPURIEN
N PRINT
K ^TMP("WV RPT",$J)
I '$D(RESULT) Q
S (CNT2,WVPURIEN,PUR)=0
S CNT=0 F S CNT=$O(RESULT(CNT)) Q:CNT="" D
. I $P($G(RESULT(CNT)),U)["WHIEN" D
. . S CNT2=CNT2+1
. . S WVIEN=$P($P($G(RESULT(CNT)),U),":",2),WVRESULT(CNT2)=$G(WVIEN)
. . S WVRESULT(CNT2)=WVRESULT(CNT2)_U_$P($P($G(RESULT(CNT)),U,3),":",2)
. I $P($G(RESULT(CNT)),U)["WHPur" D
. . S NODE=$G(RESULT(CNT)),PUR=$P($P($G(NODE),U),":",2)
. . S CNT1=1,TYPE=$P($G(NODE),U,2)
. . I TYPE'[":" D
...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)
..I TYPE[":" D
...S PIECNT=0
...F X=1:1:$L(TYPE) I $E(TYPE,X)=":" S PIECNT=PIECNT+1 I PIECNT>0 D
....S PRINT=""
....S TYP1=$P($G(TYPE),":",PIECNT)
....I TYP1="L" S PRINT=$P($G(NODE),U,3)
....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
...S PIECNT=PIECNT+1
...S PRINT=""
...S TYP1=$P($G(TYPE),":",PIECNT)
...I TYP1="L" S PRINT=$P($G(NODE),U,3)
...S WVNOT(PUR,CNT1)=$P($G(NODE),U,5)_U_$G(TYP1)_U_$G(PRINT)_U_$P($P($G(NODE),U,4),":",2)
K WHMUFIND,WHFIND,WHNAME
;DBIA #4104
D NEW^WVRPCNO(.WVRESULT,.WVNOT)
Q
;
PXRMRPCC ;SLC/PJH - PXRM REMINDER DIALOG ;11/26/2007
+1 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
+2 ;
ACTIVE(ORY,ORREM) ;Check if active dialog exist for reminders
+1 ;
+2 ; input parameter ORREM is array of reminder ien [.01#811.9]
+3 NEW DDIS,DIEN,OCNT,RIEN,RSTA
+4 SET OCNT=0
SET RIEN=0
+5 ;Get reminder ien from array
+6 FOR
SET RIEN=$ORDER(ORREM(RIEN))
IF 'RIEN
QUIT
Begin DoDot:1
+7 ;Dialog ien for reminder
+8 SET DIEN=$PIECE($GET(^PXD(811.9,RIEN,51)),U)
SET RSTA=0
+9 ;Dialog status
+10 IF DIEN
SET DDIS=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,3)
+11 ;If dialog and dialog not disabled
+12 IF DIEN
IF DDIS=""
SET RSTA=1
+13 ;Return reminder and if active dialog exists
+14 SET OCNT=OCNT+1
SET ORY(OCNT)=RIEN_U_RSTA
End DoDot:1
+15 QUIT
+16 ;
+17 ;
DIALOG(ORY,ORREM,DFN) ;Load reminder dialog associated with the reminder
+1 ;
+2 ; input parameter ORREM - reminder ien [.01,#811.9]
+3 ;
+4 SET RIEN=ORREM
+5 NEW DATA,DIEN
+6 SET DIEN=$GET(^PXD(811.9,ORREM,51))
+7 ;
+8 ;Quit if no dialog for this reminder
+9 IF 'DIEN
SET ORY(1)="-1^no dialog for this reminder"
QUIT
+10 ;
+11 ;Check if a reminder dialog and enabled
+12 SET DATA=$GET(^PXRMD(801.41,DIEN,0))
+13 ;
+14 IF $PIECE(DATA,U,4)'="R"
SET ORY(1)="-1^reminder dialog invalid"
QUIT
+15 ;
+16 IF $PIECE(DATA,U,3)
SET ORY(1)="-1^reminder dialog disabled"
QUIT
+17 ;
+18 ;Load dialog lines into local array
+19 SET ORY(0)=0_U_+$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,17)
+20 DO LOAD^PXRMDLL(DIEN,$GET(DFN))
+21 QUIT
+22 ;
HDR(ORY,ORLOC) ;Progress Note Header by location/service/user
+1 NEW ORSRV,PASS
+2 ;S ORSRV=$G(^VA(200,DUZ,5)) I +ORSRV>0 S ORSRV=$P(ORSRV,U)
+3 SET ORSRV=$$GET1^DIQ(200,DUZ,29,"I")
+4 SET PASS=DUZ_";VA(200,"
+5 IF +$GET(ORLOC)
SET PASS=PASS_"^LOC.`"_ORLOC
+6 IF ORSRV>0
SET PASS=PASS_"^SRV.`"_+$GET(ORSRV)
+7 SET ORY=$$GET^XPAR(PASS_"^DIV^SYS^PKG","PXRM PROGRESS NOTE HEADERS",1,"Q")
+8 QUIT
+9 ;
PROMPT(ORY,ORDLG,ORDCUR,ORFTYP) ;Load additional prompts for a dialog element
+1 ;
+2 ; input parameters
+3 ;
+4 ; ORDLG - dialog element ien [.01,#801.41]
+5 ; ORDCUR - 0 = current, 1 = Historical for taxonomies only
+6 ; ORFTYP - finding type (CPT/POV) for taxonomies only
+7 ;
+8 ; These fields can be found in the output array of DIALOG^PXRMRPCC
+9 ;
+10 DO LOAD^PXRMDLLA(ORDLG,ORDCUR,$GET(ORFTYP))
+11 QUIT
+12 ;
RES(ORY,ORREM) ; Reminder Resources/Inquiry
+1 ;
+2 ; input parameter ORREM - reminder ien [.01,#811.9]
+3 ;
+4 DO REMVAR^PXRMINQ(.ORY,ORREM)
+5 QUIT
+6 ;
MH(ORY,OTEST) ; Mental Health dialog
+1 ;
+2 ; Input mental health instrument NAME
+3 ;
+4 KILL ^TMP($JOB,"YSQU")
+5 NEW ARRAY,CNT,CNT1,FNODE,FSUB,IC,NODE,OCNT,SUB,YS
+6 ;DBIA #5056
+7 SET YS("CODE")=OTEST
DO SHOWALL^YTQPXRM5(.ARRAY,.YS)
+8 SET OCNT=0
SET CNT=0
+9 SET SUB="ARRAY"
SET OCNT=0
+10 FOR
SET SUB=$QUERY(@SUB)
IF SUB=""
QUIT
Begin DoDot:1
+11 SET FSUB=$PIECE($PIECE(SUB,"(",2),")")
SET FNODE=""
+12 FOR IC=1:1
SET NODE=$PIECE(FSUB,",",IC)
IF NODE=""
QUIT
Begin DoDot:2
+13 IF $EXTRACT(NODE)=""""
SET NODE=$PIECE(NODE,"""",2)
+14 SET $PIECE(FNODE,";",IC)=NODE
End DoDot:2
+15 IF FNODE=""
QUIT
+16 SET OCNT=OCNT+1
SET ORY(OCNT)=FNODE_U_@SUB
End DoDot:1
+17 QUIT
+18 ;
MHR(ORY,RESULT,ORES) ; Mental Health score and P/N text
+1 ;
+2 ; Input MH result IEN and mental health instrument response
+3 ;
+4 DO START^PXRMDLR(.ORY,RESULT,.ORES)
+5 ;
+6 QUIT
+7 ;
MHS(ORY,YS) ; Mental Health save response
+1 ;
+2 ; Input mental health instrument response
+3 NEW ANS,ARRAY,X
+4 SET ANS=$GET(YS("R1"))
KILL YS("R1")
+5 SET YS("ADATE")=YS("ADATE")_"."_$PIECE($$NOW^XLFDT,".",2)
+6 FOR X=1:1:$LENGTH(ANS)
IF $EXTRACT(ANS,X)'="X"
SET YS(X)=X_U_$EXTRACT(ANS,X)
+7 ;DBIA #4463
+8 DO SAVECR^YTQPXRM4(.ARRAY,.YS)
+9 QUIT
+10 ;
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
+2 ;to use it.
+3 QUIT
+4 ;
WH(ORY,RESULT) ;
+1 NEW CNT,CNT1,CNT2,NODE,PIECNT,PUR,TYPE,TYP1,WVIEN,WVRESULT,WVNOT,WVPURIEN
+2 NEW PRINT
+3 KILL ^TMP("WV RPT",$JOB)
+4 IF '$DATA(RESULT)
QUIT
+5 SET (CNT2,WVPURIEN,PUR)=0
+6 SET CNT=0
FOR
SET CNT=$ORDER(RESULT(CNT))
IF CNT=""
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(RESULT(CNT)),U)["WHIEN"
Begin DoDot:2
+8 SET CNT2=CNT2+1
+9 SET WVIEN=$PIECE($PIECE($GET(RESULT(CNT)),U),":",2)
SET WVRESULT(CNT2)=$GET(WVIEN)
+10 SET WVRESULT(CNT2)=WVRESULT(CNT2)_U_$PIECE($PIECE($GET(RESULT(CNT)),U,3),":",2)
End DoDot:2
+11 IF $PIECE($GET(RESULT(CNT)),U)["WHPur"
Begin DoDot:2
+12 SET NODE=$GET(RESULT(CNT))
SET PUR=$PIECE($PIECE($GET(NODE),U),":",2)
+13 SET CNT1=1
SET TYPE=$PIECE($GET(NODE),U,2)
+14 IF TYPE'[":"
Begin DoDot:3
+15 SET WVNOT(PUR,CNT1)=$PIECE($GET(NODE),U,5)_U_$PIECE($GET(NODE),U,2)_U_$PIECE($GET(NODE),U,3)_U_$PIECE($PIECE($GET(NODE),U,4),":",2)
End DoDot:3
+16 IF TYPE[":"
Begin DoDot:3
+17 SET PIECNT=0
+18 FOR X=1:1:$LENGTH(TYPE)
IF $EXTRACT(TYPE,X)=":"
SET PIECNT=PIECNT+1
IF PIECNT>0
Begin DoDot:4
+19 SET PRINT=""
+20 SET TYP1=$PIECE($GET(TYPE),":",PIECNT)
+21 IF TYP1="L"
SET PRINT=$PIECE($GET(NODE),U,3)
+22 SET WVNOT(PUR,CNT1)=$PIECE($GET(NODE),U,5)_U_$GET(TYP1)_U_$GET(PRINT)_U_$PIECE($PIECE($GET(NODE),U,4),":",2)
SET CNT1=CNT1+1
End DoDot:4
+23 SET PIECNT=PIECNT+1
+24 SET PRINT=""
+25 SET TYP1=$PIECE($GET(TYPE),":",PIECNT)
+26 IF TYP1="L"
SET PRINT=$PIECE($GET(NODE),U,3)
+27 SET WVNOT(PUR,CNT1)=$PIECE($GET(NODE),U,5)_U_$GET(TYP1)_U_$GET(PRINT)_U_$PIECE($PIECE($GET(NODE),U,4),":",2)
End DoDot:3
End DoDot:2
End DoDot:1
+28 KILL WHMUFIND,WHFIND,WHNAME
+29 ;DBIA #4104
+30 DO NEW^WVRPCNO(.WVRESULT,.WVNOT)
+31 QUIT
+32 ;
