- 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 Feb 18, 2025@23:10:33 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