PXRMDLG7 ;SLC/AGP - Reminder Dialog TESTER List Manager;Jul 12, 2022@14:08:28
;;2.0;CLINICAL REMINDERS;**45,65**;Feb 04, 2005;Build 438
;
;
BLFAIL(ARRAY) ;
N CNT,TEMP
S CNT=$O(ARRAY(""),-1)
I CNT>2 Q 0
S TEMP=1_U_U_"1"_U_"D"_U_"1"_U_U_U_"0"_U_U
I $G(ARRAY(1))'=TEMP Q 0
S TEMP=2_U_U_"1"_U_"Clinical Reminder evaluation error; this reminder dialog cannot be processed.<br>Please contact the reminder manager for assistance."
I ARRAY(CNT)'=TEMP Q 0
W !,"Clinical Reminder evaluation error; this reminder dialog cannot be processed."
W !,"Please contact the reminder manager for assistance."
H 2
Q 1
;
EN ;
N ARRAY,VIEW
S VALMBCK="R"
D TESTER(.ARRAY,PXRMDIEN,.VIEW)
I '$D(ARRAY) D BUILD^PXRMDLG(0) Q
I $$BLFAIL(.ARRAY) D BUILD^PXRMDLG(0) Q
D START
Q
;Display national dialog
START N NLINE,NSEL
S NLINE=0,NSEL=0
;
S PXRMDTST=1
K ^TMP("PXRMDLG",$J)
D BUILD
;Create headings
D CHGCAP^VALM("HEADER1","Item Seq.")
I VIEW=1 D CHGCAP^VALM("HEADER2","Tester Dialog Details")
I VIEW=2 D CHGCAP^VALM("HEADER2","Tester Dialog Text")
I VIEW=3 D CHGCAP^VALM("HEADER2","Tester Progress Note Text")
I VIEW=1 D CHGCAP^VALM("HEADER3","Type")
S VALMCNT=NLINE
S ^TMP("PXRMDLG",$J,"VALMCNT")=VALMCNT
D XQORM^PXRMDLG
EXIT Q
;
BUILD ;
N I,IEN,OUTPUT,PIECES,SEQ,SEQLAST,SEQS,TESTDATA
S I=0 F S I=$O(ARRAY(I)) Q:I'>0 D
.S OUTPUT=$G(ARRAY(I)) Q:OUTPUT="" Q:$P(OUTPUT,U)=2
.S IEN=$P(OUTPUT,U,2),SEQ=$P(OUTPUT,U,3)
.;break out seq to mimic going through the DD entry
.S PIECES=$L(SEQ,".")
.I PIECES=1 S SEQS="",SEQLAST=SEQ
.I PIECES>1 D
..S ^TMP("PXRMDLG",$J,"SEQ",SEQ)=IEN
..S SEQS=$P(SEQ,".",1,PIECES-1)_"."
..S SEQLAST=$P(SEQ,".",PIECES)
.I VIEW=1 D DLINE^PXRMDLG3(IEN,SEQS,SEQLAST)
.I VIEW>1 S TESTDATA=$$TESTDATA(IEN,OUTPUT) D DLINE^PXRMDLG4(IEN,SEQS,SEQLAST,"PXRMDLG")
.S ^TMP("PXRMDLG",$J,"IEN",NSEL)=IEN_U_SEQLAST
Q
;
ISTEST() ;
Q +$G(PXRMDTST)
;
TESTDATA(IEN,NODE) ;
N RESULT
S RESULT=$G(^PXRMD(801.41,IEN,0))
S $P(RESULT,U,11)=$S($P(NODE,U,4)="D":1,$P(NODE,U,4)="C":"C",1:"")
S $P(RESULT,U,14)=$P(NODE,U,10)
S $P(RESULT,U,10)=$P(NODE,U,15)
S $P(RESULT,U,7)=$P(NODE,U,16)
S $P(RESULT,U,8)=$P(NODE,U,17)
S $P(RESULT,U,9)=$P(NODE,U,18)
S $P(RESULT,U,6)=$S($P(NODE,U,19)=1:"Y",1:"N")
S $P(RESULT,U,5)=$P(NODE,U,20)
S $P(RESULT,U,12)=$P(NODE,U,21)
Q RESULT
;
TESTER(ARRAY,PXRMDIEN,VIEW) ;
;Prompt for patient and dialog.
N DATE,DIR,DFN,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,HASFF,HASTERM,IND
N PXRHM,PXRMFFSS,PXRMITEM,PXRMTDEB,OCNT,ORY,X,Y
S VIEW=-1
GVIEW ;
S DIR(0)="SB^DD:DETAILED DISPLAY;DP:DIALOG PROGRESS NOTE;DT:DIALOG TEXT"
S DIR("A")="Select View:"
S DIR("B")="DD"
D ^DIR
I Y=U G GVIEW
I Y=U_U Q
S VIEW=$S(Y="DD":1,Y="DP":3,Y="DT":2,1:-1)
I VIEW=-1 Q
S DIC=2,DIC("A")="Select Patient: "
S DIC(0)="AEQMZ"
GPAT1 D ^DIC
I $D(DIROUT)!$D(DIRUT) Q
I $D(DTOUT)!$D(DUOUT) Q
S DFN=+$P(Y,U,1)
I DFN=-1 G GPAT1
D LOAD^PXRMDLL(PXRMDIEN,DFN,"")
M ARRAY=ORY
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLG7 3023 printed Dec 13, 2024@01:43:58 Page 2
PXRMDLG7 ;SLC/AGP - Reminder Dialog TESTER List Manager;Jul 12, 2022@14:08:28
+1 ;;2.0;CLINICAL REMINDERS;**45,65**;Feb 04, 2005;Build 438
+2 ;
+3 ;
BLFAIL(ARRAY) ;
+1 NEW CNT,TEMP
+2 SET CNT=$ORDER(ARRAY(""),-1)
+3 IF CNT>2
QUIT 0
+4 SET TEMP=1_U_U_"1"_U_"D"_U_"1"_U_U_U_"0"_U_U
+5 IF $GET(ARRAY(1))'=TEMP
QUIT 0
+6 SET TEMP=2_U_U_"1"_U_"Clinical Reminder evaluation error; this reminder dialog cannot be processed.<br>Please contact the reminder manager for assistance."
+7 IF ARRAY(CNT)'=TEMP
QUIT 0
+8 WRITE !,"Clinical Reminder evaluation error; this reminder dialog cannot be processed."
+9 WRITE !,"Please contact the reminder manager for assistance."
+10 HANG 2
+11 QUIT 1
+12 ;
EN ;
+1 NEW ARRAY,VIEW
+2 SET VALMBCK="R"
+3 DO TESTER(.ARRAY,PXRMDIEN,.VIEW)
+4 IF '$DATA(ARRAY)
DO BUILD^PXRMDLG(0)
QUIT
+5 IF $$BLFAIL(.ARRAY)
DO BUILD^PXRMDLG(0)
QUIT
+6 DO START
+7 QUIT
+8 ;Display national dialog
START NEW NLINE,NSEL
+1 SET NLINE=0
SET NSEL=0
+2 ;
+3 SET PXRMDTST=1
+4 KILL ^TMP("PXRMDLG",$JOB)
+5 DO BUILD
+6 ;Create headings
+7 DO CHGCAP^VALM("HEADER1","Item Seq.")
+8 IF VIEW=1
DO CHGCAP^VALM("HEADER2","Tester Dialog Details")
+9 IF VIEW=2
DO CHGCAP^VALM("HEADER2","Tester Dialog Text")
+10 IF VIEW=3
DO CHGCAP^VALM("HEADER2","Tester Progress Note Text")
+11 IF VIEW=1
DO CHGCAP^VALM("HEADER3","Type")
+12 SET VALMCNT=NLINE
+13 SET ^TMP("PXRMDLG",$JOB,"VALMCNT")=VALMCNT
+14 DO XQORM^PXRMDLG
EXIT QUIT
+1 ;
BUILD ;
+1 NEW I,IEN,OUTPUT,PIECES,SEQ,SEQLAST,SEQS,TESTDATA
+2 SET I=0
FOR
SET I=$ORDER(ARRAY(I))
if I'>0
QUIT
Begin DoDot:1
+3 SET OUTPUT=$GET(ARRAY(I))
if OUTPUT=""
QUIT
if $PIECE(OUTPUT,U)=2
QUIT
+4 SET IEN=$PIECE(OUTPUT,U,2)
SET SEQ=$PIECE(OUTPUT,U,3)
+5 ;break out seq to mimic going through the DD entry
+6 SET PIECES=$LENGTH(SEQ,".")
+7 IF PIECES=1
SET SEQS=""
SET SEQLAST=SEQ
+8 IF PIECES>1
Begin DoDot:2
+9 SET ^TMP("PXRMDLG",$JOB,"SEQ",SEQ)=IEN
+10 SET SEQS=$PIECE(SEQ,".",1,PIECES-1)_"."
+11 SET SEQLAST=$PIECE(SEQ,".",PIECES)
End DoDot:2
+12 IF VIEW=1
DO DLINE^PXRMDLG3(IEN,SEQS,SEQLAST)
+13 IF VIEW>1
SET TESTDATA=$$TESTDATA(IEN,OUTPUT)
DO DLINE^PXRMDLG4(IEN,SEQS,SEQLAST,"PXRMDLG")
+14 SET ^TMP("PXRMDLG",$JOB,"IEN",NSEL)=IEN_U_SEQLAST
End DoDot:1
+15 QUIT
+16 ;
ISTEST() ;
+1 QUIT +$GET(PXRMDTST)
+2 ;
TESTDATA(IEN,NODE) ;
+1 NEW RESULT
+2 SET RESULT=$GET(^PXRMD(801.41,IEN,0))
+3 SET $PIECE(RESULT,U,11)=$SELECT($PIECE(NODE,U,4)="D":1,$PIECE(NODE,U,4)="C":"C",1:"")
+4 SET $PIECE(RESULT,U,14)=$PIECE(NODE,U,10)
+5 SET $PIECE(RESULT,U,10)=$PIECE(NODE,U,15)
+6 SET $PIECE(RESULT,U,7)=$PIECE(NODE,U,16)
+7 SET $PIECE(RESULT,U,8)=$PIECE(NODE,U,17)
+8 SET $PIECE(RESULT,U,9)=$PIECE(NODE,U,18)
+9 SET $PIECE(RESULT,U,6)=$SELECT($PIECE(NODE,U,19)=1:"Y",1:"N")
+10 SET $PIECE(RESULT,U,5)=$PIECE(NODE,U,20)
+11 SET $PIECE(RESULT,U,12)=$PIECE(NODE,U,21)
+12 QUIT RESULT
+13 ;
TESTER(ARRAY,PXRMDIEN,VIEW) ;
+1 ;Prompt for patient and dialog.
+2 NEW DATE,DIR,DFN,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,HASFF,HASTERM,IND
+3 NEW PXRHM,PXRMFFSS,PXRMITEM,PXRMTDEB,OCNT,ORY,X,Y
+4 SET VIEW=-1
GVIEW ;
+1 SET DIR(0)="SB^DD:DETAILED DISPLAY;DP:DIALOG PROGRESS NOTE;DT:DIALOG TEXT"
+2 SET DIR("A")="Select View:"
+3 SET DIR("B")="DD"
+4 DO ^DIR
+5 IF Y=U
GOTO GVIEW
+6 IF Y=U_U
QUIT
+7 SET VIEW=$SELECT(Y="DD":1,Y="DP":3,Y="DT":2,1:-1)
+8 IF VIEW=-1
QUIT
+9 SET DIC=2
SET DIC("A")="Select Patient: "
+10 SET DIC(0)="AEQMZ"
GPAT1 DO ^DIC
+1 IF $DATA(DIROUT)!$DATA(DIRUT)
QUIT
+2 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+3 SET DFN=+$PIECE(Y,U,1)
+4 IF DFN=-1
GOTO GPAT1
+5 DO LOAD^PXRMDLL(PXRMDIEN,DFN,"")
+6 MERGE ARRAY=ORY
+7 QUIT
+8 ;
