PXRMDLR3 ;SLC/AGP - Dialog reporting routine to find active CPRS dialogs ;10/18/2021
;;2.0;CLINICAL REMINDERS;**45,65**;Feb 04, 2005;Build 438
Q
;
APIONE(SUB,ITEM,GBL,RETIEN) ;
N ALL,ITEMS,PXRMDAPI,PXRMFAIL
K ^TMP("PXRM DIALOG LISTS",$J)
K ^TMP($J,SUB)
S PXRMDAPI=1,PXRMFAIL=0
S ^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL,ITEM)=""
D BLDLIST^PXRMDLR2
I PXRMFAIL=1 S ^TMP($J,SUB,ITEM_";"_GBL,"ERROR")="" Q
S ITEMS(ITEM_";"_GBL)=""
S ALL=$S(ITEM="ALL":1,1:0)
D APIBLD(.ITEMS,SUB,ALL,RETIEN)
K ^TMP("PXRM DIALOG LISTS",$J)
Q
;
APIALL(SUB,ITEMS,RETIEN,SPINNER) ;
N CNT,FAIL,GBL,IEN,ITEM,PXRMDMUL,SPINCNT,SUB1,TEMP
K ^TMP($J,SUB)
S SUB1="PXRM DIALOG SINGLE",PXRMDMUL=1,FAIL=0,SPINCNT=0
S ITEM="" F S ITEM=$O(ITEMS(ITEM)) Q:ITEM="" D
.I FAIL=1 S ^TMP($J,SUB,ITEM,"ERROR")="" Q
.S IEN=+ITEM,GBL=$P(ITEM,";",2)
.I SPINNER=1 D SPIN("Searching Reminder Dialogs",.SPINCNT)
.D APIONE(SUB1,IEN,GBL,RETIEN)
.I '$D(^TMP($J,SUB1)) Q
.I $D(^TMP($J,SUB1,ITEM,"ERROR")) S FAIL=1 Q
.M ^TMP($J,SUB,ITEM)=^TMP($J,SUB1,ITEM)
Q
;
APIBLD(ITEMS,SUB,ALL,RETIEN) ;
N CNT,FIND,IEN,ITEM,LIST,NODE,NUM,TEMP,TYPE,X
;scan through dialogs
S IEN=0 F S IEN=$O(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",IEN)) Q:IEN'>0 D
.K TEMP S CNT=1,TEMP(CNT)="Dialog: "_$P(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",IEN),U)
.I RETIEN=1 S TEMP(CNT)=TEMP(CNT)_U_IEN
.S NUM=0 F S NUM=$O(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",IEN,"REASON",NUM)) Q:NUM'>0 D
..S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",IEN,"REASON",NUM)) I $P(NODE,U,2)'>0 Q
..S CNT=CNT+1,TEMP(CNT)=" "_$P(NODE,U)
..I RETIEN S TEMP(CNT)=TEMP(CNT)_U_$P(NODE,U,2)
..S ITEM=$P(NODE,U,2),LIST(ITEM,IEN)="" I '$D(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM)) Q
..S FIND=0 F S FIND=$O(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM,"REASON",FIND)) Q:FIND'>0 D
...S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM,"REASON",FIND)) I $P(NODE,U,2)="" Q
...I 'ALL,'$D(ITEMS($P(NODE,U,2))) Q
...S X=$O(^TMP($J,SUB,$P(NODE,U,2),""),-1)+1
...M ^TMP($J,SUB,$P(NODE,U,2),X)=TEMP
;
;scan through items for any items not on a dialog
S ITEM=0 F S ITEM=$O(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM)) Q:ITEM'>0 D
.I $D(LIST(ITEM)) Q
.S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM)) S TYPE=$$RETTYPE^PXRMDLR2($P(NODE,U,4)) I TYPE="" Q
.K TEMP S CNT=1,TEMP(CNT)="Dialog "_TYPE_": "_$P(NODE,U)
.I RETIEN S TEMP(CNT)=TEMP(CNT)_U_ITEM
.S FIND=0 F S FIND=$O(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM,"REASON",FIND)) Q:FIND'>0 D
..S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM,"REASON",FIND)) I $P(NODE,U,2)="" Q
..I 'ALL,'$D(ITEMS($P(NODE,U,2))) Q
..S X=$O(^TMP($J,SUB,$P(NODE,U,2),""),-1)+1
..M ^TMP($J,SUB,$P(NODE,U,2),X)=TEMP
Q
;
REASONO(FIND,GBL,NL) ;
N CNT,DIFF,IND,LVL,NODE,NOUT,REASON,SPACER,TCNT,TEXT,TEXTOUT,SEQ,SLVL,SSEQ,X
S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL,FIND,"SEQ")) Q:NODE=""
S CNT=$P(NODE,U),SEQ=$P(NODE,U,2) Q:CNT'>0 Q:SEQ=""
S SLVL=$L(SEQ,".")-1 S SSEQ=$P(SEQ,".",1,SLVL)
S TCNT=0
S SPACER=" "
;S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ORDER STRUCTURE",CNT,SEQ)) Q:NODE=""
;S TCNT=TCNT+1,TEXT(TCNT)=SPACER_$P(NODE,U,5)_": "_$P(NODE,U,2)_"\\"
S REASON=$G(^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL,FIND,"REASON",1)) Q:REASON=""
F S SEQ=$O(^TMP("PXRM DIALOG LISTS",$J,"ORDER STRUCTURE",CNT,SEQ)) Q:SEQ=""!($P(SEQ,".",1,SLVL)'=$P(SSEQ,".",1,SLVL)) D
.S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ORDER STRUCTURE",CNT,SEQ)) Q:NODE=""
.S LVL=$L(SEQ,".")-1 S DIFF=LVL-SLVL
.S SPACER=" "
.I DIFF>1 F X=1:1:DIFF S SPACER=SPACER_" "
.S TCNT=TCNT+1,TEXT(TCNT)=SPACER_$P(NODE,U,5)_": "_$P(NODE,U,2)_"\\"
S TCNT=TCNT+1,SPACER=SPACER_" ",TEXT(TCNT)=SPACER_REASON
D FORMAT^PXRMTEXT(10,72,.TCNT,.TEXT,.NOUT,.TEXTOUT)
F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
Q
;
REASONP(ITEM,NL,START) ;
N CNT,GBL,IEN,IND,NODE,NOUT,SPACER,TAB,TEMP,TEXT,TEXTOUT
I ITEM[";" S IEN=$P(ITEM,";"),GBL=$P(ITEM,";",2)
I ITEM'[";" S IEN=ITEM
S TEMP=$S(START="DIALOG":"ITEM",START="ITEM":"FINDING",1:"")
I START="FINDING" D Q
.I GBL["ORD(101.41" D REASONO(IEN,GBL,.NL) Q
.S CNT=0,GBL="PXD(811.2,"
.F S CNT=$O(^TMP("PXRM DIALOG LISTS",$J,START,GBL,IEN,"REASON",CNT)) Q:CNT'>0 D
..S TEXT=$G(^TMP("PXRM DIALOG LISTS",$J,START,GBL,IEN,"REASON",CNT)) Q:TEXT=""
..D FORMATS^PXRMTEXT(10,72,TEXT,.NOUT,.TEXTOUT)
..F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
S CNT=0
F S CNT=$O(^TMP("PXRM DIALOG LISTS",$J,START,IEN,"REASON",CNT)) Q:CNT'>0 D
.S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,START,IEN,"REASON",CNT))
.S TEXT=$P(NODE,U)
.S TAB=$S(TEMP="ITEM":7,1:9)
.D FORMATS^PXRMTEXT(TAB,72,TEXT,.NOUT,.TEXTOUT)
.F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
.I TEMP="" Q
.I START="DIALOG",$D(^TMP("PXRM DIALOG LISTS",$J,TEMP,$P(NODE,U,2),"REASON")) D REASONP($P(NODE,U,2),.NL,TEMP) Q
.I START="ITEM",$D(^TMP("PXRM DIALOG LISTS",$J,TEMP,$P($P(NODE,U,2),";",2),$P($P(NODE,U,2),";"),"REASON")) D REASONP($P(NODE,U,2),.NL,TEMP) Q
Q
;
REPORT(FINAL,TEMPDIAL,CPRSONLY,SHOWREAS) ;
N DIEN,CNT,FIRST,GROUP,HEADER,IND,LOCN,NAME,NL,NODE,NOUT,PATH,TEXT,TEXTOUT,X
;FINAL(GROUP,"CPRS Cover Sheet Reminder",$P(NODE,U,4))=DIEN_U_$P(NODE,U,1,4)
;FINAL(GROUP,"CPRS Template",$P(NODE,U,4))=DIEN_U_$P(NODE,U,1,4)
S NL=1,^TMP("PXRMXMZ",$J,NL,0)="Clinical Reminders Dialogs search report."
S FIRST=1
S GROUP="" F S GROUP=$O(FINAL(GROUP)) Q:GROUP="" D
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
. I CPRSONLY=0 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Reminder Dialogs:"
. I CPRSONLY=1 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="CPRS Cover Sheet Reminder Dialogs for "_GROUP_":"
.S CNT=0
.;write CPRS Cover Sheet or report on all dialogs
.F X="CPRS Cover Sheet Reminder","Reminder Dialog" D
..I '$D(FINAL(GROUP,X)) Q
..S NAME="" F S NAME=$O(FINAL(GROUP,X,NAME)) Q:NAME="" D
...I SHOWREAS=1 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
...S TEXT="Dialog: "_NAME,CNT=CNT+1
...D FORMATS^PXRMTEXT(5,72,TEXT,.NOUT,.TEXTOUT)
...F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
...S DIEN=$P($G(FINAL(GROUP,X,NAME)),U)
...I SHOWREAS=1,$D(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN,"REASON")) D
....S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Match Criteria:" D REASONP(DIEN,.NL,"DIALOG")
.I CNT=0 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None Found"
I CPRSONLY=0 Q
;write templates with reminder dialogs.
;S CNT=0 W !!!,"CPRS Template Dialogs: "
S CNT=0,NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="",NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="CPRS Template Dialogs: "
S NAME="" F S NAME=$O(TEMPDIAL(NAME)) Q:NAME="" D
.S TEXT="Dialog: "_NAME,CNT=CNT+1
.D FORMATS^PXRMTEXT(5,72,TEXT,.NOUT,.TEXTOUT)
.F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
.S DIEN=$P($G(TEMPDIAL(NAME)),U)
.I SHOWREAS=1,$D(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN,"REASON")) D
..S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Match Criteria:" D REASONP(DIEN,.NL,"DIALOG")
I CNT=0 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None Found"
;
Q
;
SPIN(TEXT,SPINCNT) ;Move the spinner.
N QUAD
I SPINCNT=0 W !!,TEXT," "
S SPINCNT=SPINCNT+1
S QUAD=SPINCNT#8
I QUAD=1 W @IOBS,"|"
I QUAD=3 W @IOBS,"/"
I QUAD=5 W @IOBS,"-"
I QUAD=7 W @IOBS,"\"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLR3 7300 printed Apr 09, 2024@20:51:43 Page 2
PXRMDLR3 ;SLC/AGP - Dialog reporting routine to find active CPRS dialogs ;10/18/2021
+1 ;;2.0;CLINICAL REMINDERS;**45,65**;Feb 04, 2005;Build 438
+2 QUIT
+3 ;
APIONE(SUB,ITEM,GBL,RETIEN) ;
+1 NEW ALL,ITEMS,PXRMDAPI,PXRMFAIL
+2 KILL ^TMP("PXRM DIALOG LISTS",$JOB)
+3 KILL ^TMP($JOB,SUB)
+4 SET PXRMDAPI=1
SET PXRMFAIL=0
+5 SET ^TMP("PXRM DIALOG LISTS",$JOB,"FINDING",GBL,ITEM)=""
+6 DO BLDLIST^PXRMDLR2
+7 IF PXRMFAIL=1
SET ^TMP($JOB,SUB,ITEM_";"_GBL,"ERROR")=""
QUIT
+8 SET ITEMS(ITEM_";"_GBL)=""
+9 SET ALL=$SELECT(ITEM="ALL":1,1:0)
+10 DO APIBLD(.ITEMS,SUB,ALL,RETIEN)
+11 KILL ^TMP("PXRM DIALOG LISTS",$JOB)
+12 QUIT
+13 ;
APIALL(SUB,ITEMS,RETIEN,SPINNER) ;
+1 NEW CNT,FAIL,GBL,IEN,ITEM,PXRMDMUL,SPINCNT,SUB1,TEMP
+2 KILL ^TMP($JOB,SUB)
+3 SET SUB1="PXRM DIALOG SINGLE"
SET PXRMDMUL=1
SET FAIL=0
SET SPINCNT=0
+4 SET ITEM=""
FOR
SET ITEM=$ORDER(ITEMS(ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+5 IF FAIL=1
SET ^TMP($JOB,SUB,ITEM,"ERROR")=""
QUIT
+6 SET IEN=+ITEM
SET GBL=$PIECE(ITEM,";",2)
+7 IF SPINNER=1
DO SPIN("Searching Reminder Dialogs",.SPINCNT)
+8 DO APIONE(SUB1,IEN,GBL,RETIEN)
+9 IF '$DATA(^TMP($JOB,SUB1))
QUIT
+10 IF $DATA(^TMP($JOB,SUB1,ITEM,"ERROR"))
SET FAIL=1
QUIT
+11 MERGE ^TMP($JOB,SUB,ITEM)=^TMP($JOB,SUB1,ITEM)
End DoDot:1
+12 QUIT
+13 ;
APIBLD(ITEMS,SUB,ALL,RETIEN) ;
+1 NEW CNT,FIND,IEN,ITEM,LIST,NODE,NUM,TEMP,TYPE,X
+2 ;scan through dialogs
+3 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",IEN))
if IEN'>0
QUIT
Begin DoDot:1
+4 KILL TEMP
SET CNT=1
SET TEMP(CNT)="Dialog: "_$PIECE(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",IEN),U)
+5 IF RETIEN=1
SET TEMP(CNT)=TEMP(CNT)_U_IEN
+6 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",IEN,"REASON",NUM))
if NUM'>0
QUIT
Begin DoDot:2
+7 SET NODE=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",IEN,"REASON",NUM))
IF $PIECE(NODE,U,2)'>0
QUIT
+8 SET CNT=CNT+1
SET TEMP(CNT)=" "_$PIECE(NODE,U)
+9 IF RETIEN
SET TEMP(CNT)=TEMP(CNT)_U_$PIECE(NODE,U,2)
+10 SET ITEM=$PIECE(NODE,U,2)
SET LIST(ITEM,IEN)=""
IF '$DATA(^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",ITEM))
QUIT
+11 SET FIND=0
FOR
SET FIND=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",ITEM,"REASON",FIND))
if FIND'>0
QUIT
Begin DoDot:3
+12 SET NODE=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",ITEM,"REASON",FIND))
IF $PIECE(NODE,U,2)=""
QUIT
+13 IF 'ALL
IF '$DATA(ITEMS($PIECE(NODE,U,2)))
QUIT
+14 SET X=$ORDER(^TMP($JOB,SUB,$PIECE(NODE,U,2),""),-1)+1
+15 MERGE ^TMP($JOB,SUB,$PIECE(NODE,U,2),X)=TEMP
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 ;scan through items for any items not on a dialog
+18 SET ITEM=0
FOR
SET ITEM=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",ITEM))
if ITEM'>0
QUIT
Begin DoDot:1
+19 IF $DATA(LIST(ITEM))
QUIT
+20 SET NODE=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",ITEM))
SET TYPE=$$RETTYPE^PXRMDLR2($PIECE(NODE,U,4))
IF TYPE=""
QUIT
+21 KILL TEMP
SET CNT=1
SET TEMP(CNT)="Dialog "_TYPE_": "_$PIECE(NODE,U)
+22 IF RETIEN
SET TEMP(CNT)=TEMP(CNT)_U_ITEM
+23 SET FIND=0
FOR
SET FIND=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",ITEM,"REASON",FIND))
if FIND'>0
QUIT
Begin DoDot:2
+24 SET NODE=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"ITEM",ITEM,"REASON",FIND))
IF $PIECE(NODE,U,2)=""
QUIT
+25 IF 'ALL
IF '$DATA(ITEMS($PIECE(NODE,U,2)))
QUIT
+26 SET X=$ORDER(^TMP($JOB,SUB,$PIECE(NODE,U,2),""),-1)+1
+27 MERGE ^TMP($JOB,SUB,$PIECE(NODE,U,2),X)=TEMP
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;
REASONO(FIND,GBL,NL) ;
+1 NEW CNT,DIFF,IND,LVL,NODE,NOUT,REASON,SPACER,TCNT,TEXT,TEXTOUT,SEQ,SLVL,SSEQ,X
+2 SET NODE=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"FINDING",GBL,FIND,"SEQ"))
if NODE=""
QUIT
+3 SET CNT=$PIECE(NODE,U)
SET SEQ=$PIECE(NODE,U,2)
if CNT'>0
QUIT
if SEQ=""
QUIT
+4 SET SLVL=$LENGTH(SEQ,".")-1
SET SSEQ=$PIECE(SEQ,".",1,SLVL)
+5 SET TCNT=0
+6 SET SPACER=" "
+7 ;S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ORDER STRUCTURE",CNT,SEQ)) Q:NODE=""
+8 ;S TCNT=TCNT+1,TEXT(TCNT)=SPACER_$P(NODE,U,5)_": "_$P(NODE,U,2)_"\\"
+9 SET REASON=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"FINDING",GBL,FIND,"REASON",1))
if REASON=""
QUIT
+10 FOR
SET SEQ=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,"ORDER STRUCTURE",CNT,SEQ))
if SEQ=""!($PIECE(SEQ,".",1,SLVL)'=$PIECE(SSEQ,".",1,SLVL))
QUIT
Begin DoDot:1
+11 SET NODE=$GET(^TMP("PXRM DIALOG LISTS",$JOB,"ORDER STRUCTURE",CNT,SEQ))
if NODE=""
QUIT
+12 SET LVL=$LENGTH(SEQ,".")-1
SET DIFF=LVL-SLVL
+13 SET SPACER=" "
+14 IF DIFF>1
FOR X=1:1:DIFF
SET SPACER=SPACER_" "
+15 SET TCNT=TCNT+1
SET TEXT(TCNT)=SPACER_$PIECE(NODE,U,5)_": "_$PIECE(NODE,U,2)_"\\"
End DoDot:1
+16 SET TCNT=TCNT+1
SET SPACER=SPACER_" "
SET TEXT(TCNT)=SPACER_REASON
+17 DO FORMAT^PXRMTEXT(10,72,.TCNT,.TEXT,.NOUT,.TEXTOUT)
+18 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
+19 QUIT
+20 ;
REASONP(ITEM,NL,START) ;
+1 NEW CNT,GBL,IEN,IND,NODE,NOUT,SPACER,TAB,TEMP,TEXT,TEXTOUT
+2 IF ITEM[";"
SET IEN=$PIECE(ITEM,";")
SET GBL=$PIECE(ITEM,";",2)
+3 IF ITEM'[";"
SET IEN=ITEM
+4 SET TEMP=$SELECT(START="DIALOG":"ITEM",START="ITEM":"FINDING",1:"")
+5 IF START="FINDING"
Begin DoDot:1
+6 IF GBL["ORD(101.41"
DO REASONO(IEN,GBL,.NL)
QUIT
+7 SET CNT=0
SET GBL="PXD(811.2,"
+8 FOR
SET CNT=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,START,GBL,IEN,"REASON",CNT))
if CNT'>0
QUIT
Begin DoDot:2
+9 SET TEXT=$GET(^TMP("PXRM DIALOG LISTS",$JOB,START,GBL,IEN,"REASON",CNT))
if TEXT=""
QUIT
+10 DO FORMATS^PXRMTEXT(10,72,TEXT,.NOUT,.TEXTOUT)
+11 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
End DoDot:2
End DoDot:1
QUIT
+12 SET CNT=0
+13 FOR
SET CNT=$ORDER(^TMP("PXRM DIALOG LISTS",$JOB,START,IEN,"REASON",CNT))
if CNT'>0
QUIT
Begin DoDot:1
+14 SET NODE=$GET(^TMP("PXRM DIALOG LISTS",$JOB,START,IEN,"REASON",CNT))
+15 SET TEXT=$PIECE(NODE,U)
+16 SET TAB=$SELECT(TEMP="ITEM":7,1:9)
+17 DO FORMATS^PXRMTEXT(TAB,72,TEXT,.NOUT,.TEXTOUT)
+18 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
+19 IF TEMP=""
QUIT
+20 IF START="DIALOG"
IF $DATA(^TMP("PXRM DIALOG LISTS",$JOB,TEMP,$PIECE(NODE,U,2),"REASON"))
DO REASONP($PIECE(NODE,U,2),.NL,TEMP)
QUIT
+21 IF START="ITEM"
IF $DATA(^TMP("PXRM DIALOG LISTS",$JOB,TEMP,$PIECE($PIECE(NODE,U,2),";",2),$PIECE($PIECE(NODE,U,2),";"),"REASON"))
DO REASONP($PIECE(NODE,U,2),.NL,TEMP)
QUIT
End DoDot:1
+22 QUIT
+23 ;
REPORT(FINAL,TEMPDIAL,CPRSONLY,SHOWREAS) ;
+1 NEW DIEN,CNT,FIRST,GROUP,HEADER,IND,LOCN,NAME,NL,NODE,NOUT,PATH,TEXT,TEXTOUT,X
+2 ;FINAL(GROUP,"CPRS Cover Sheet Reminder",$P(NODE,U,4))=DIEN_U_$P(NODE,U,1,4)
+3 ;FINAL(GROUP,"CPRS Template",$P(NODE,U,4))=DIEN_U_$P(NODE,U,1,4)
+4 SET NL=1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Clinical Reminders Dialogs search report."
+5 SET FIRST=1
+6 SET GROUP=""
FOR
SET GROUP=$ORDER(FINAL(GROUP))
if GROUP=""
QUIT
Begin DoDot:1
+7 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+8 IF CPRSONLY=0
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="Reminder Dialogs:"
+9 IF CPRSONLY=1
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="CPRS Cover Sheet Reminder Dialogs for "_GROUP_":"
+10 SET CNT=0
+11 ;write CPRS Cover Sheet or report on all dialogs
+12 FOR X="CPRS Cover Sheet Reminder","Reminder Dialog"
Begin DoDot:2
+13 IF '$DATA(FINAL(GROUP,X))
QUIT
+14 SET NAME=""
FOR
SET NAME=$ORDER(FINAL(GROUP,X,NAME))
if NAME=""
QUIT
Begin DoDot:3
+15 IF SHOWREAS=1
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+16 SET TEXT="Dialog: "_NAME
SET CNT=CNT+1
+17 DO FORMATS^PXRMTEXT(5,72,TEXT,.NOUT,.TEXTOUT)
+18 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
+19 SET DIEN=$PIECE($GET(FINAL(GROUP,X,NAME)),U)
+20 IF SHOWREAS=1
IF $DATA(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN,"REASON"))
Begin DoDot:4
+21 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Match Criteria:"
DO REASONP(DIEN,.NL,"DIALOG")
End DoDot:4
End DoDot:3
End DoDot:2
+22 IF CNT=0
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None Found"
End DoDot:1
+23 IF CPRSONLY=0
QUIT
+24 ;write templates with reminder dialogs.
+25 ;S CNT=0 W !!!,"CPRS Template Dialogs: "
+26 SET CNT=0
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=""
+27 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)="CPRS Template Dialogs: "
+28 SET NAME=""
FOR
SET NAME=$ORDER(TEMPDIAL(NAME))
if NAME=""
QUIT
Begin DoDot:1
+29 SET TEXT="Dialog: "_NAME
SET CNT=CNT+1
+30 DO FORMATS^PXRMTEXT(5,72,TEXT,.NOUT,.TEXTOUT)
+31 FOR IND=1:1:NOUT
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=TEXTOUT(IND)
+32 SET DIEN=$PIECE($GET(TEMPDIAL(NAME)),U)
+33 IF SHOWREAS=1
IF $DATA(^TMP("PXRM DIALOG LISTS",$JOB,"DIALOG",DIEN,"REASON"))
Begin DoDot:2
+34 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" Match Criteria:"
DO REASONP(DIEN,.NL,"DIALOG")
End DoDot:2
End DoDot:1
+35 IF CNT=0
SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" None Found"
+36 ;
+37 QUIT
+38 ;
SPIN(TEXT,SPINCNT) ;Move the spinner.
+1 NEW QUAD
+2 IF SPINCNT=0
WRITE !!,TEXT," "
+3 SET SPINCNT=SPINCNT+1
+4 SET QUAD=SPINCNT#8
+5 IF QUAD=1
WRITE @IOBS,"|"
+6 IF QUAD=3
WRITE @IOBS,"/"
+7 IF QUAD=5
WRITE @IOBS,"-"
+8 IF QUAD=7
WRITE @IOBS,"\"
+9 QUIT
