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

PXRMDLR3.m

Go to the documentation of this file.
  1. 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
  1. Q
  1. ;
  1. APIONE(SUB,ITEM,GBL,RETIEN) ;
  1. N ALL,ITEMS,PXRMDAPI,PXRMFAIL
  1. K ^TMP("PXRM DIALOG LISTS",$J)
  1. K ^TMP($J,SUB)
  1. S PXRMDAPI=1,PXRMFAIL=0
  1. S ^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL,ITEM)=""
  1. D BLDLIST^PXRMDLR2
  1. I PXRMFAIL=1 S ^TMP($J,SUB,ITEM_";"_GBL,"ERROR")="" Q
  1. S ITEMS(ITEM_";"_GBL)=""
  1. S ALL=$S(ITEM="ALL":1,1:0)
  1. D APIBLD(.ITEMS,SUB,ALL,RETIEN)
  1. K ^TMP("PXRM DIALOG LISTS",$J)
  1. Q
  1. ;
  1. APIALL(SUB,ITEMS,RETIEN,SPINNER) ;
  1. N CNT,FAIL,GBL,IEN,ITEM,PXRMDMUL,SPINCNT,SUB1,TEMP
  1. K ^TMP($J,SUB)
  1. S SUB1="PXRM DIALOG SINGLE",PXRMDMUL=1,FAIL=0,SPINCNT=0
  1. S ITEM="" F S ITEM=$O(ITEMS(ITEM)) Q:ITEM="" D
  1. .I FAIL=1 S ^TMP($J,SUB,ITEM,"ERROR")="" Q
  1. .S IEN=+ITEM,GBL=$P(ITEM,";",2)
  1. .I SPINNER=1 D SPIN("Searching Reminder Dialogs",.SPINCNT)
  1. .D APIONE(SUB1,IEN,GBL,RETIEN)
  1. .I '$D(^TMP($J,SUB1)) Q
  1. .I $D(^TMP($J,SUB1,ITEM,"ERROR")) S FAIL=1 Q
  1. .M ^TMP($J,SUB,ITEM)=^TMP($J,SUB1,ITEM)
  1. Q
  1. ;
  1. APIBLD(ITEMS,SUB,ALL,RETIEN) ;
  1. N CNT,FIND,IEN,ITEM,LIST,NODE,NUM,TEMP,TYPE,X
  1. ;scan through dialogs
  1. S IEN=0 F S IEN=$O(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",IEN)) Q:IEN'>0 D
  1. .K TEMP S CNT=1,TEMP(CNT)="Dialog: "_$P(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",IEN),U)
  1. .I RETIEN=1 S TEMP(CNT)=TEMP(CNT)_U_IEN
  1. .S NUM=0 F S NUM=$O(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",IEN,"REASON",NUM)) Q:NUM'>0 D
  1. ..S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",IEN,"REASON",NUM)) I $P(NODE,U,2)'>0 Q
  1. ..S CNT=CNT+1,TEMP(CNT)=" "_$P(NODE,U)
  1. ..I RETIEN S TEMP(CNT)=TEMP(CNT)_U_$P(NODE,U,2)
  1. ..S ITEM=$P(NODE,U,2),LIST(ITEM,IEN)="" I '$D(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM)) Q
  1. ..S FIND=0 F S FIND=$O(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM,"REASON",FIND)) Q:FIND'>0 D
  1. ...S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM,"REASON",FIND)) I $P(NODE,U,2)="" Q
  1. ...I 'ALL,'$D(ITEMS($P(NODE,U,2))) Q
  1. ...S X=$O(^TMP($J,SUB,$P(NODE,U,2),""),-1)+1
  1. ...M ^TMP($J,SUB,$P(NODE,U,2),X)=TEMP
  1. ;
  1. ;scan through items for any items not on a dialog
  1. S ITEM=0 F S ITEM=$O(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM)) Q:ITEM'>0 D
  1. .I $D(LIST(ITEM)) Q
  1. .S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM)) S TYPE=$$RETTYPE^PXRMDLR2($P(NODE,U,4)) I TYPE="" Q
  1. .K TEMP S CNT=1,TEMP(CNT)="Dialog "_TYPE_": "_$P(NODE,U)
  1. .I RETIEN S TEMP(CNT)=TEMP(CNT)_U_ITEM
  1. .S FIND=0 F S FIND=$O(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM,"REASON",FIND)) Q:FIND'>0 D
  1. ..S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ITEM",ITEM,"REASON",FIND)) I $P(NODE,U,2)="" Q
  1. ..I 'ALL,'$D(ITEMS($P(NODE,U,2))) Q
  1. ..S X=$O(^TMP($J,SUB,$P(NODE,U,2),""),-1)+1
  1. ..M ^TMP($J,SUB,$P(NODE,U,2),X)=TEMP
  1. Q
  1. ;
  1. REASONO(FIND,GBL,NL) ;
  1. N CNT,DIFF,IND,LVL,NODE,NOUT,REASON,SPACER,TCNT,TEXT,TEXTOUT,SEQ,SLVL,SSEQ,X
  1. S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL,FIND,"SEQ")) Q:NODE=""
  1. S CNT=$P(NODE,U),SEQ=$P(NODE,U,2) Q:CNT'>0 Q:SEQ=""
  1. S SLVL=$L(SEQ,".")-1 S SSEQ=$P(SEQ,".",1,SLVL)
  1. S TCNT=0
  1. S SPACER=" "
  1. ;S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ORDER STRUCTURE",CNT,SEQ)) Q:NODE=""
  1. ;S TCNT=TCNT+1,TEXT(TCNT)=SPACER_$P(NODE,U,5)_": "_$P(NODE,U,2)_"\\"
  1. S REASON=$G(^TMP("PXRM DIALOG LISTS",$J,"FINDING",GBL,FIND,"REASON",1)) Q:REASON=""
  1. F S SEQ=$O(^TMP("PXRM DIALOG LISTS",$J,"ORDER STRUCTURE",CNT,SEQ)) Q:SEQ=""!($P(SEQ,".",1,SLVL)'=$P(SSEQ,".",1,SLVL)) D
  1. .S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,"ORDER STRUCTURE",CNT,SEQ)) Q:NODE=""
  1. .S LVL=$L(SEQ,".")-1 S DIFF=LVL-SLVL
  1. .S SPACER=" "
  1. .I DIFF>1 F X=1:1:DIFF S SPACER=SPACER_" "
  1. .S TCNT=TCNT+1,TEXT(TCNT)=SPACER_$P(NODE,U,5)_": "_$P(NODE,U,2)_"\\"
  1. S TCNT=TCNT+1,SPACER=SPACER_" ",TEXT(TCNT)=SPACER_REASON
  1. D FORMAT^PXRMTEXT(10,72,.TCNT,.TEXT,.NOUT,.TEXTOUT)
  1. F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1. Q
  1. ;
  1. REASONP(ITEM,NL,START) ;
  1. N CNT,GBL,IEN,IND,NODE,NOUT,SPACER,TAB,TEMP,TEXT,TEXTOUT
  1. I ITEM[";" S IEN=$P(ITEM,";"),GBL=$P(ITEM,";",2)
  1. I ITEM'[";" S IEN=ITEM
  1. S TEMP=$S(START="DIALOG":"ITEM",START="ITEM":"FINDING",1:"")
  1. I START="FINDING" D Q
  1. .I GBL["ORD(101.41" D REASONO(IEN,GBL,.NL) Q
  1. .S CNT=0,GBL="PXD(811.2,"
  1. .F S CNT=$O(^TMP("PXRM DIALOG LISTS",$J,START,GBL,IEN,"REASON",CNT)) Q:CNT'>0 D
  1. ..S TEXT=$G(^TMP("PXRM DIALOG LISTS",$J,START,GBL,IEN,"REASON",CNT)) Q:TEXT=""
  1. ..D FORMATS^PXRMTEXT(10,72,TEXT,.NOUT,.TEXTOUT)
  1. ..F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1. S CNT=0
  1. F S CNT=$O(^TMP("PXRM DIALOG LISTS",$J,START,IEN,"REASON",CNT)) Q:CNT'>0 D
  1. .S NODE=$G(^TMP("PXRM DIALOG LISTS",$J,START,IEN,"REASON",CNT))
  1. .S TEXT=$P(NODE,U)
  1. .S TAB=$S(TEMP="ITEM":7,1:9)
  1. .D FORMATS^PXRMTEXT(TAB,72,TEXT,.NOUT,.TEXTOUT)
  1. .F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1. .I TEMP="" Q
  1. .I START="DIALOG",$D(^TMP("PXRM DIALOG LISTS",$J,TEMP,$P(NODE,U,2),"REASON")) D REASONP($P(NODE,U,2),.NL,TEMP) Q
  1. .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
  1. Q
  1. ;
  1. REPORT(FINAL,TEMPDIAL,CPRSONLY,SHOWREAS) ;
  1. N DIEN,CNT,FIRST,GROUP,HEADER,IND,LOCN,NAME,NL,NODE,NOUT,PATH,TEXT,TEXTOUT,X
  1. ;FINAL(GROUP,"CPRS Cover Sheet Reminder",$P(NODE,U,4))=DIEN_U_$P(NODE,U,1,4)
  1. ;FINAL(GROUP,"CPRS Template",$P(NODE,U,4))=DIEN_U_$P(NODE,U,1,4)
  1. S NL=1,^TMP("PXRMXMZ",$J,NL,0)="Clinical Reminders Dialogs search report."
  1. S FIRST=1
  1. S GROUP="" F S GROUP=$O(FINAL(GROUP)) Q:GROUP="" D
  1. . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1. . I CPRSONLY=0 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="Reminder Dialogs:"
  1. . I CPRSONLY=1 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="CPRS Cover Sheet Reminder Dialogs for "_GROUP_":"
  1. .S CNT=0
  1. .;write CPRS Cover Sheet or report on all dialogs
  1. .F X="CPRS Cover Sheet Reminder","Reminder Dialog" D
  1. ..I '$D(FINAL(GROUP,X)) Q
  1. ..S NAME="" F S NAME=$O(FINAL(GROUP,X,NAME)) Q:NAME="" D
  1. ...I SHOWREAS=1 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1. ...S TEXT="Dialog: "_NAME,CNT=CNT+1
  1. ...D FORMATS^PXRMTEXT(5,72,TEXT,.NOUT,.TEXTOUT)
  1. ...F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1. ...S DIEN=$P($G(FINAL(GROUP,X,NAME)),U)
  1. ...I SHOWREAS=1,$D(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN,"REASON")) D
  1. ....S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Match Criteria:" D REASONP(DIEN,.NL,"DIALOG")
  1. .I CNT=0 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None Found"
  1. I CPRSONLY=0 Q
  1. ;write templates with reminder dialogs.
  1. ;S CNT=0 W !!!,"CPRS Template Dialogs: "
  1. S CNT=0,NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="",NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=""
  1. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)="CPRS Template Dialogs: "
  1. S NAME="" F S NAME=$O(TEMPDIAL(NAME)) Q:NAME="" D
  1. .S TEXT="Dialog: "_NAME,CNT=CNT+1
  1. .D FORMATS^PXRMTEXT(5,72,TEXT,.NOUT,.TEXTOUT)
  1. .F IND=1:1:NOUT S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=TEXTOUT(IND)
  1. .S DIEN=$P($G(TEMPDIAL(NAME)),U)
  1. .I SHOWREAS=1,$D(^TMP("PXRM DIALOG LISTS",$J,"DIALOG",DIEN,"REASON")) D
  1. ..S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" Match Criteria:" D REASONP(DIEN,.NL,"DIALOG")
  1. I CNT=0 S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" None Found"
  1. ;
  1. Q
  1. ;
  1. SPIN(TEXT,SPINCNT) ;Move the spinner.
  1. N QUAD
  1. I SPINCNT=0 W !!,TEXT," "
  1. S SPINCNT=SPINCNT+1
  1. S QUAD=SPINCNT#8
  1. I QUAD=1 W @IOBS,"|"
  1. I QUAD=3 W @IOBS,"/"
  1. I QUAD=5 W @IOBS,"-"
  1. I QUAD=7 W @IOBS,"\"
  1. Q