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.
PXRMDLR3 ;SLC/AGP - Dialog reporting routine to find active CPRS dialogs ;04/20/2018
 ;;2.0;CLINICAL REMINDERS;**45**;Feb 04, 2005;Build 566
 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) ;
 N CNT,FAIL,GBL,IEN,ITEM,PXRMDMUL,SUB1,TEMP
 K ^TMP($J,SUB)
 S SUB1="PXRM DIALOG SINGLE",PXRMDMUL=1,FAIL=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)
 .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