[613] | 1 | PXRMDLST ; SLC/PJH - Reminder Dialog Inquiry ;05/30/2000
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
---|
| 3 | ;
|
---|
| 4 | ;
|
---|
| 5 | START N BY,DC,DHD,DIC,EXPAND,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
|
---|
| 6 | N PXRMFIEN,PXRMHD
|
---|
| 7 | ;
|
---|
| 8 | S LIT="ALL DIALOGS"
|
---|
| 9 | I PXRMDTYP="R" S LIT="REMINDER DIALOGS"
|
---|
| 10 | I PXRMDTYP="P" S LIT="DIALOG PROMPTS"
|
---|
| 11 | I PXRMDTYP="F" S LIT="DIALOG FORCED VALUES"
|
---|
| 12 | I PXRMDTYP="E" S LIT="DIALOG ELEMENTS"
|
---|
| 13 | I PXRMDTYP="G" S LIT="DIALOG GROUPS"
|
---|
| 14 | ;
|
---|
| 15 | ;DIC is killed by DIP.
|
---|
| 16 | SELECT S DIC="^PXRMD(801.41,"
|
---|
| 17 | S DIC(0)="AEMQ"
|
---|
| 18 | S DIC("A")="Select Dialog Definition: "
|
---|
| 19 | ;Current dialog type only
|
---|
| 20 | S DIC("S")="I $P(^(0),U,4)=PXRMDTYP"
|
---|
| 21 | D ^DIC
|
---|
| 22 | I Y'=-1 D G SELECT
|
---|
| 23 | .;^DIP options
|
---|
| 24 | .D SET
|
---|
| 25 | .D DISP
|
---|
| 26 | END Q
|
---|
| 27 | ;
|
---|
| 28 | ;List all (for protocol PXRM SELECTION LIST)
|
---|
| 29 | ;--------
|
---|
| 30 | ALL N BY,DC,DHD,DIC,DIS,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
|
---|
| 31 | S LIT="ALL DIALOGS"
|
---|
| 32 | I PXRMDTYP="R" S LIT="REMINDER DIALOGS"
|
---|
| 33 | I PXRMDTYP="P" S LIT="DIALOG PROMPTS"
|
---|
| 34 | I PXRMDTYP="E" S LIT="DIALOG ELEMENTS"
|
---|
| 35 | I PXRMDTYP="G" S LIT="DIALOG GROUPS"
|
---|
| 36 | I PXRMDTYP="F" S LIT="DIALOG FORCED VALUES"
|
---|
| 37 | I $G(PXRMGTYP)="DLG" S LIT="REMINDER DIALOGS"
|
---|
| 38 | S Y=1
|
---|
| 39 | D SET
|
---|
| 40 | S DIC="^PXRMD(801.41,"
|
---|
| 41 | ;
|
---|
| 42 | I PXRMDTYP'="A" S DIS(0)="I $P($G(^PXRMD(801.41,D0,0)),U,4)=PXRMDTYP"
|
---|
| 43 | S BY=".01"
|
---|
| 44 | S FR=""
|
---|
| 45 | S TO=""
|
---|
| 46 | S DHD="W ?0 D HED^PXRMDLST"
|
---|
| 47 | D DISP
|
---|
| 48 | Q
|
---|
| 49 | ;
|
---|
| 50 | ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
|
---|
| 51 | ;--------------------
|
---|
| 52 | INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
|
---|
| 53 | S DIC="^PXRMD(801.41,"
|
---|
| 54 | S DIC(0)="AEMQ"
|
---|
| 55 | D SET
|
---|
| 56 | D DISP
|
---|
| 57 | Q
|
---|
| 58 | ;
|
---|
| 59 | ;Inquiry/Print for dialog edit (for protocol PXRM DIALOG SELECTION INQ)
|
---|
| 60 | ;-----------------------------
|
---|
| 61 | INQ1 W IORESET
|
---|
| 62 | D START
|
---|
| 63 | Q
|
---|
| 64 | ;
|
---|
| 65 | ;
|
---|
| 66 | ;Display using print templates
|
---|
| 67 | ;-----------------------------
|
---|
| 68 | DISP S L=0,FLDS="[PXRM REMINDER DIALOG]"
|
---|
| 69 | I PXRMDTYP="E" S FLDS="[PXRM DIALOG ELEMENT]"
|
---|
| 70 | I PXRMDTYP="F" S FLDS="[PXRM DIALOG FORCED VALUE]"
|
---|
| 71 | I PXRMDTYP="G" S FLDS="[PXRM DIALOG GROUP]"
|
---|
| 72 | I PXRMDTYP="P" S FLDS="[PXRM DIALOG PROMPT]"
|
---|
| 73 | I PXRMDTYP="S" S FLDS="[PXRM RESULT GROUP]"
|
---|
| 74 | I PXRMDTYP="T" S FLDS="[PXRM RESULT ELEMENT]"
|
---|
| 75 | ;
|
---|
| 76 | D EN1^DIP
|
---|
| 77 | Q
|
---|
| 78 | ;
|
---|
| 79 | ;Header
|
---|
| 80 | ;------
|
---|
| 81 | HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
|
---|
| 82 | S TEXTHED="REMINDER DIALOG INQUIRY"
|
---|
| 83 | S TEXTUND=$TR($J("",IOM)," ","-")
|
---|
| 84 | S TEMP=NOW_" Page "_DC
|
---|
| 85 | S TEXTLEN=$L(TEMP)
|
---|
| 86 | W TEXTHED
|
---|
| 87 | W ?(IOM-TEXTLEN),TEMP
|
---|
| 88 | W !,TEXTUND,!!
|
---|
| 89 | Q
|
---|
| 90 | ;
|
---|
| 91 | ;Get question text
|
---|
| 92 | ;-----------------
|
---|
| 93 | PROMPT N DTYP,FIRST,NODE,SUB,LINE,TAB
|
---|
| 94 | S SUB=$P(X,U,2) Q:SUB=""
|
---|
| 95 | S DTYP=$P($G(^PXRMD(801.41,SUB,0)),U,4) Q:DTYP=""
|
---|
| 96 | ;Dialog element
|
---|
| 97 | I DTYP="E" D Q
|
---|
| 98 | .S NODE=0,FIRST=1,TAB=26
|
---|
| 99 | .F S NODE=$O(^PXRMD(801.41,SUB,25,NODE)) Q:'NODE D
|
---|
| 100 | ..S LINE=$G(^PXRMD(801.41,SUB,25,NODE,0))
|
---|
| 101 | ..I 'FIRST W !
|
---|
| 102 | ..I FIRST,$L(LINE)>50 W ! S TAB=2
|
---|
| 103 | ..W ?TAB,LINE
|
---|
| 104 | ;Prompt/Forced Value
|
---|
| 105 | I "FP"[DTYP W $P($G(^PXRMD(801.41,SUB,2)),U,4)
|
---|
| 106 | Q
|
---|
| 107 | ;
|
---|
| 108 | SET ;Setup all the variables
|
---|
| 109 | ; Set Date for Header
|
---|
| 110 | S NOW=$$NOW^XLFDT
|
---|
| 111 | S NOW=$$FMTE^XLFDT(NOW,"1P")
|
---|
| 112 | ;
|
---|
| 113 | ;These variables need to be setup every time because DIP kills them.
|
---|
| 114 | S BY="NUMBER"
|
---|
| 115 | S (FR,TO)=+$P(Y,U,1)
|
---|
| 116 | S DHD="W ?0 D HED^PXRMDLST"
|
---|
| 117 | ;
|
---|
| 118 | Q
|
---|
| 119 | ;
|
---|
| 120 | ;Orderable item
|
---|
| 121 | ;--------------
|
---|
| 122 | ORDER I '$G(D0) Q
|
---|
| 123 | N QNAM,QORDER,RIEN,RNAM
|
---|
| 124 | S RIEN=$P($G(^PXRMD(801.41,D0,1)),U,3),RNAM=""
|
---|
| 125 | I RIEN S RNAM=$P($G(^PXRMD(801.9,RIEN,0)),U)
|
---|
| 126 | I RNAM'="ORDERED" W ?24,"N/A" Q
|
---|
| 127 | S QORDER=$P($G(^PXRMD(801.41,D0,1)),U,7)
|
---|
| 128 | I 'QORDER W ?24,"None" Q
|
---|
| 129 | S QNAM=$P($G(^ORD(101.43,QORDER,0)),U) I QNAM="" S QNAM="Unknown"
|
---|
| 130 | W ?24,QNAM," (OI["_QORDER_"])"
|
---|
| 131 | Q
|
---|
| 132 | ;
|
---|
| 133 | ;Dialog ELEMENT pointed to by REMINDER DIALOGS/GROUPS
|
---|
| 134 | ;----------------------------------------------------
|
---|
| 135 | REPLACE(DIEN,TAB,CUR) ;
|
---|
| 136 | Q:'$G(DIEN)
|
---|
| 137 | N DSUB,DENAM,DETYP,DTLIT,DMES
|
---|
| 138 | S DSUB=0
|
---|
| 139 | F S DSUB=$O(^PXRMD(801.41,"R",DIEN,DSUB)) Q:'DSUB D
|
---|
| 140 | .S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
|
---|
| 141 | .S DENAM=$P(DATA,U) Q:DENAM=""
|
---|
| 142 | .S DETYP=$P(DATA,U,4) Q:DETYP=""
|
---|
| 143 | .S DTLIT="??",DMES="" S:CUR=DSUB DMES="Current "
|
---|
| 144 | .I DETYP="G" S DTLIT="Dialog Group"
|
---|
| 145 | .I DETYP="E" S DTLIT="Dialog Element"
|
---|
| 146 | .W ?TAB,DENAM_" ("_DMES_DTLIT_")",!
|
---|
| 147 | Q
|
---|
| 148 | ;
|
---|
| 149 | USE(DIEN,TAB,CUR) ;
|
---|
| 150 | Q:'$G(DIEN)
|
---|
| 151 | N DSUB,DENAM,DETYP,DTLIT,DMES
|
---|
| 152 | S DSUB=0
|
---|
| 153 | F S DSUB=$O(^PXRMD(801.41,"AD",DIEN,DSUB)) Q:'DSUB D
|
---|
| 154 | .S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
|
---|
| 155 | .S DENAM=$P(DATA,U) Q:DENAM=""
|
---|
| 156 | .S DETYP=$P(DATA,U,4) Q:DETYP=""
|
---|
| 157 | .S DTLIT="??",DMES="" S:CUR=DSUB DMES="Current "
|
---|
| 158 | .I DETYP="R" S DTLIT="Reminder Dialog"
|
---|
| 159 | .I DETYP="G" S DTLIT="Dialog Group"
|
---|
| 160 | .I DETYP="E" S DTLIT="Dialog Element"
|
---|
| 161 | .I DETYP="S" S DTLIT="Result Group"
|
---|
| 162 | .W ?TAB,DENAM_" ("_DMES_DTLIT_")",!
|
---|
| 163 | Q
|
---|