[623] | 1 | PXRMDLLA ;SLC/PJH - REMINDER DIALOG LOADER ;07/29/2004
|
---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
---|
| 3 | ;
|
---|
| 4 | FREC(DFIEN,DFTYP) ;Build type 3 record
|
---|
| 5 | N CSARRAY,CSCNT
|
---|
| 6 | ;Dialog type/text and resolution
|
---|
| 7 | S DNAM=$$NAME(DFIEN,DFTYP)
|
---|
| 8 | D CODE^PXRMDLLB(DFIEN,DFTYP,.CSARRAY)
|
---|
| 9 | I $D(CSARRAY)>0 D Q
|
---|
| 10 | . S CSCNT="" F S CSCNT=$O(CSARRAY(CSCNT)) Q:CSCNT="" D
|
---|
| 11 | . . S OCNT=OCNT+1
|
---|
| 12 | . . S ORY(OCNT)=3_U_DITEM_U_U_DPCE_U_DEXC_U_DFIEN_U_$G(CSARRAY(CSCNT))_U_DNAM_U_U_DVIT
|
---|
| 13 | ;Translate vitals ien to PCE code - This will need a DBIA
|
---|
| 14 | S DCOD=""
|
---|
| 15 | I DPCE="VIT" D
|
---|
| 16 | .S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
|
---|
| 17 | .;Vitals Caption
|
---|
| 18 | .S DVIT=$P($G(^PXRMD(801.41,DITEM,2)),U,4)
|
---|
| 19 | I DFTYP]"" D
|
---|
| 20 | .S OCNT=OCNT+1
|
---|
| 21 | .S ORY(OCNT)=3_U_DITEM_U_U_DPCE_U_DEXC_U_DFIEN_U_$G(DCOD)_U_DNAM_U_U_DVIT
|
---|
| 22 | .;Get order type for orderable items
|
---|
| 23 | .;DBIA #3110
|
---|
| 24 | .S:DPCE="Q" $P(ORY(OCNT),U,11)=$P($G(^ORD(101.41,DFIEN,0)),U,4)
|
---|
| 25 | .;If mental health check if a GAF score and if MH test is required
|
---|
| 26 | .I DPCE="MH",DFIEN D
|
---|
| 27 | ..I $P($G(^YTT(601,DFIEN,0)),U)="GAF" S $P(ORY(OCNT),U,12)=1
|
---|
| 28 | ..;Check to see if the MH test is required
|
---|
| 29 | ..S $P(ORY(OCNT),U,13)=$S($P($G(^PXRMD(801.41,DITEM,0)),U,18)=1:1,1:0)
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | GUI(IEN) ;Work out prompt type for PCE
|
---|
| 33 | Q:IEN="" ""
|
---|
| 34 | N SUB S SUB=$P($G(^PXRMD(801.41,IEN,46)),U)
|
---|
| 35 | Q:'SUB ""
|
---|
| 36 | Q $P($G(^PXRMD(801.42,SUB,0)),U)
|
---|
| 37 | ;
|
---|
| 38 | LOAD(DITEM,DCUR,DTTYP) ;Load dialog questions into array
|
---|
| 39 | N DARRAY,DCOD,DEXC,DFIND,DFIEN,DFTYP,DNAM,DPCE,DRES,DSEQ,DSUB,DTYP,OCNT
|
---|
| 40 | N DVIT,NODE,CNT,IDENT
|
---|
| 41 | ;DBIA #3110 OR(101.41
|
---|
| 42 | ;
|
---|
| 43 | ;Build list of PCE codes
|
---|
| 44 | S DARRAY("AUTTEDT(")="PED"
|
---|
| 45 | S DARRAY("AUTTEXAM(")="XAM"
|
---|
| 46 | S DARRAY("AUTTHF(")="HF"
|
---|
| 47 | S DARRAY("AUTTIMM(")="IMM"
|
---|
| 48 | S DARRAY("AUTTSK(")="SK"
|
---|
| 49 | ;
|
---|
| 50 | S DARRAY("GMRD(120.51,")="VIT"
|
---|
| 51 | S DARRAY("ORD(101.41,")="Q"
|
---|
| 52 | S DARRAY("YTT(601,")="MH"
|
---|
| 53 | ;
|
---|
| 54 | S DARRAY("ICD9(")="POV"
|
---|
| 55 | S DARRAY("ICPT(")="CPT"
|
---|
| 56 | S DARRAY("WV(790.404,")="WH"
|
---|
| 57 | S DARRAY("WV(790.1,")="WHR"
|
---|
| 58 | ;
|
---|
| 59 | S DARRAY("PXD(811.2,")="T"
|
---|
| 60 | ;
|
---|
| 61 | ;Get the dialog element
|
---|
| 62 | S OCNT=0
|
---|
| 63 | N TERMNODE,TERMSTAT,TERMOUT
|
---|
| 64 | S DTYP=$P($G(^PXRMD(801.41,DITEM,0)),U,4)
|
---|
| 65 | ;Finding detail
|
---|
| 66 | S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
|
---|
| 67 | S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
|
---|
| 68 | ;check for WH finding
|
---|
| 69 | I $P($G(^PXRMD(801.41,DITEM,0)),U,16)["WHR" S DFIND=$G(WHFIND)
|
---|
| 70 | ;
|
---|
| 71 | S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
|
---|
| 72 | S DPCE="",DVIT="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
|
---|
| 73 | ;Exclude from P/N
|
---|
| 74 | S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
|
---|
| 75 | ;
|
---|
| 76 | ;Non taxonomy codes (3 - finding record)
|
---|
| 77 | I DPCE'="T" D FREC(DFIEN,DFTYP)
|
---|
| 78 | ;
|
---|
| 79 | ;Taxonomy codes need expanding (3 - finding record)
|
---|
| 80 | I DPCE="T" D EXP^PXRMDLLB(DFIEN,DCUR,DTTYP)
|
---|
| 81 | ;
|
---|
| 82 | ;Prompt details (4 - prompt records)
|
---|
| 83 | N ARRAY,DTITLE,DREQ,DSEQ,DSSEQ,DSUB,DTYP
|
---|
| 84 | ;If not a taxonomy get prompts from dialog file
|
---|
| 85 | I DPCE'="T" D PROTH(DITEM)
|
---|
| 86 | ;Check for MST findings
|
---|
| 87 | I (DPCE'="T"),(DFTYP]"") D MST^PXRMDLLB(DFTYP,DFIEN)
|
---|
| 88 | ;If taxonomy use finding parameters (CPT/POV)
|
---|
| 89 | I DPCE="T" D
|
---|
| 90 | .;Quit if finding type not passed
|
---|
| 91 | .Q:DTTYP=""
|
---|
| 92 | .N RSUB,FNODE
|
---|
| 93 | .;Get parameter file node for this finding type
|
---|
| 94 | .S FNODE=$O(^PXRMD(801.45,"B",DTTYP,"")) Q:FNODE=""
|
---|
| 95 | .;Derive resolution from line ien 1=done 2=done elsewhere
|
---|
| 96 | .S RSUB=DCUR+1 I (RSUB<1)!(RSUB>2) Q
|
---|
| 97 | .;Get details from 811.5
|
---|
| 98 | .D PRTAX(FNODE,RSUB)
|
---|
| 99 | ;Return array of type 4 records
|
---|
| 100 | S DSEQ=""
|
---|
| 101 | F S DSEQ=$O(ARRAY(DSEQ)) Q:'DSEQ D
|
---|
| 102 | .S OCNT=OCNT+1
|
---|
| 103 | .S ORY(OCNT)=4_U_DITEM_U_DSEQ_U_ARRAY(DSEQ)
|
---|
| 104 | .S DSSEQ=""
|
---|
| 105 | .F S DSSEQ=$O(ARRAY(DSEQ,DSSEQ)) Q:'DSSEQ D
|
---|
| 106 | ..S OCNT=OCNT+1
|
---|
| 107 | ..S ORY(OCNT)=4_U_DITEM_U_DSEQ_"."_DSSEQ_U_ARRAY(DSEQ,DSSEQ)
|
---|
| 108 | ;
|
---|
| 109 | ;Get progress note text if defined
|
---|
| 110 | I DPCE'="T" D:'DEXC PTXT(DITEM)
|
---|
| 111 | ;Additional findings
|
---|
| 112 | N FASUB
|
---|
| 113 | S FASUB=0
|
---|
| 114 | F S FASUB=$O(^PXRMD(801.41,DITEM,3,FASUB)) Q:'FASUB D
|
---|
| 115 | .S DFIND=$P($G(^PXRMD(801.41,DITEM,3,FASUB,0)),U)
|
---|
| 116 | .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2) Q:DFTYP="" Q:DFIEN=""
|
---|
| 117 | .S DVIT="",DPCE=$G(DARRAY(DFTYP))
|
---|
| 118 | .I DPCE'="" D FREC(DFIEN,DFTYP)
|
---|
| 119 | Q
|
---|
| 120 | ;
|
---|
| 121 | ;
|
---|
| 122 | ;Returns item name
|
---|
| 123 | NAME(DFIEN,DFTYP) ;
|
---|
| 124 | Q:DFTYP="" ""
|
---|
| 125 | Q:DFIEN="" ""
|
---|
| 126 | N NAME,FGLOB,POSN
|
---|
| 127 | ;DBIA #4108
|
---|
| 128 | I DFTYP="WV(790.404," S NAME=$P($G(^WV(790.404,DFIEN,0)),U) Q:NAME]"" NAME
|
---|
| 129 | I DFTYP="WV(790.1," S NAME=$G(WHNAME) K WHNAME Q:NAME]"" NAME
|
---|
| 130 | S POSN=2
|
---|
| 131 | S:DFTYP["AUTT" POSN=1 S:DFTYP["AUTTEDT" POSN=4 S:DFTYP["ICD" POSN=3
|
---|
| 132 | S FGLOB=U_DFTYP_DFIEN_",0)",NAME=$P($G(@FGLOB),U,POSN)
|
---|
| 133 | I (POSN>1),NAME="" S NAME=$P($G(@FGLOB),U)
|
---|
| 134 | I NAME="" S NAME=DFIEN
|
---|
| 135 | Q NAME
|
---|
| 136 | ;
|
---|
| 137 | PROTH(IEN) ; Additional prompts defined in 801.41
|
---|
| 138 | N DDATA,DDEF,DIEN,DEXC,DGUI,DNAME,DOVR,DREQ,DSEQ,DSNL,DSUB,DFTEXT
|
---|
| 139 | N DTXT,DTYP,PRINT
|
---|
| 140 | S DSEQ=0
|
---|
| 141 | F S DSEQ=$O(^PXRMD(801.41,IEN,10,"B",DSEQ)) Q:'DSEQ D
|
---|
| 142 | .;Get prompts in sequence
|
---|
| 143 | .S DSUB=$O(^PXRMD(801.41,IEN,10,"B",DSEQ,"")) Q:'DSUB
|
---|
| 144 | .;Prompt ien
|
---|
| 145 | .S DIEN=$P($G(^PXRMD(801.41,IEN,10,DSUB,0)),U,2) Q:'DIEN
|
---|
| 146 | .;Ignore disabled components, and those that are not prompts
|
---|
| 147 | .Q:($P($G(^PXRMD(801.41,DIEN,0)),U,3)]"")!("PF"'[$P($G(^(0)),U,4))
|
---|
| 148 | .;Set defaults to null
|
---|
| 149 | .S DDEF="",DEXC="",DREQ="",DSNL=""
|
---|
| 150 | .;Prompt name and GUI process (quit if null)
|
---|
| 151 | .S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U),DGUI=$$GUI(DIEN)
|
---|
| 152 | .I $G(DGUI)="WH_NOT_PURP" D
|
---|
| 153 | ..S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
|
---|
| 154 | .;Type Prompt or Forced
|
---|
| 155 | .S DTYP=$P($G(^PXRMD(801.41,DIEN,0)),U,4)
|
---|
| 156 | .I "PF"[DTYP D
|
---|
| 157 | ..;Required/Prompt caption
|
---|
| 158 | ..S DDATA=$G(^PXRMD(801.41,DIEN,2)),DTXT=$P(DDATA,U,4)
|
---|
| 159 | ..;Default value or forced value
|
---|
| 160 | ..S:DTYP="P" DDEF=$P(DDATA,U) S:DTYP="F" DDEF=$P(DDATA,U,2)
|
---|
| 161 | ..;Override caption/start new line/exclude PN from dialog file
|
---|
| 162 | ..S DDATA=$G(^PXRMD(801.41,IEN,10,DSUB,0)),DREQ=$P(DDATA,U,9)
|
---|
| 163 | ..S DOVR=$P(DDATA,U,6),DSNL=$P(DDATA,U,7),DEXC=$P(DDATA,U,8)
|
---|
| 164 | ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
|
---|
| 165 | ..;Convert date to fileman format
|
---|
| 166 | ..I DGUI="VST_DATE",DDEF["T" S DDEF=$$DT^XLFDT()
|
---|
| 167 | .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_$G(DFTEXT)_U_$G(PRINT)
|
---|
| 168 | .;the following section add a comment prompt to the WH review of result
|
---|
| 169 | .;section of the reminder dialog
|
---|
| 170 | .I DGUI="WH_PAP_RESULT",DFTYP="WV(790.1,",DTYP="P" D
|
---|
| 171 | ..N WHCNT,WHFLAG,WHNUM,WHLOOP
|
---|
| 172 | ..S WHNUM=DSEQ+1,WHLOOP=0
|
---|
| 173 | ..F WHLOOP=0 D
|
---|
| 174 | ...S (WHCNT,WHFLAG)=0
|
---|
| 175 | ...F S WHCNT=$O(^PXRMD(801.41,IEN,10,"B",WHCNT)) Q:'WHCNT!(WHFLAG=1) D
|
---|
| 176 | ....I WHCNT=WHNUM S WHFLAG=1,WHNUM=WHNUM+1
|
---|
| 177 | ...I WHFLAG=0 S WHLOOP=1
|
---|
| 178 | ..S ARRAY(WHNUM)="COM"_U_U_U_"P"_U_"Comment:"_U_U_U
|
---|
| 179 | .;Additional checkboxes
|
---|
| 180 | .I DGUI="COM",DIEN>1 D
|
---|
| 181 | ..N DSSEQ,DSUB,DTEXT
|
---|
| 182 | ..S DSSEQ=0
|
---|
| 183 | ..F S DSSEQ=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ)) Q:'DSSEQ D
|
---|
| 184 | ...S DSUB=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ,"")) Q:'DSUB
|
---|
| 185 | ...S DTEXT=$P($G(^PXRMD(801.41,DIEN,45,DSUB,0)),U,2) Q:DTEXT=""
|
---|
| 186 | ...S ARRAY(DSEQ,DSSEQ)=U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
|
---|
| 187 | Q
|
---|
| 188 | ;
|
---|
| 189 | PRTAX(FNODE,RSUB) ;Get all additional fields for this resolution type
|
---|
| 190 | N ACNT,ASUB
|
---|
| 191 | N DDATA,DDEF,DEXC,DGUI,DNAME,DREQ,DSEQ,DSUB,DTYP,PRINT
|
---|
| 192 | S ASUB=0,DSEQ=0
|
---|
| 193 | F S ASUB=$O(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB)) Q:'ASUB D
|
---|
| 194 | .S DDATA=$G(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB,0)) Q:DDATA=""
|
---|
| 195 | .;Ignore if disabled
|
---|
| 196 | .I $P(DDATA,U,3)=1 Q
|
---|
| 197 | .S DSUB=$P(DDATA,U) Q:DDATA=""
|
---|
| 198 | .S DSEQ=DSEQ+1
|
---|
| 199 | .;Set defaults to null
|
---|
| 200 | .S DDEF="",DEXC="",DREQ="",DSNL=""
|
---|
| 201 | .;Prompt name and GUI process (quit if null)
|
---|
| 202 | .S DNAME=$P($G(^PXRMD(801.41,DSUB,0)),U),DGUI=$$GUI(DSUB)
|
---|
| 203 | .I $G(DGUI)="WH_NOT_PURP" D
|
---|
| 204 | ..S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
|
---|
| 205 | .;Type Prompt or Forced
|
---|
| 206 | .S DTYP=$P($G(^PXRMD(801.41,DSUB,0)),U,4)
|
---|
| 207 | .I DTYP="P" D
|
---|
| 208 | ..S DREQ=$P(DDATA,U,2),DTXT=$P($G(^PXRMD(801.41,DSUB,2)),U,4)
|
---|
| 209 | ..;Override caption/start new line/exclude from PN from finding type
|
---|
| 210 | ..S DOVR=$P(DDATA,U,5),DSNL=$P(DDATA,U,6),DEXC=$P(DDATA,U,7)
|
---|
| 211 | ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
|
---|
| 212 | ..;Required/Prompt caption
|
---|
| 213 | ..S DDATA=$G(^PXRMD(801.41,DSUB,2))
|
---|
| 214 | .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_U_$G(PRINT)
|
---|
| 215 | Q
|
---|
| 216 | ;
|
---|
| 217 | PTXT(ITEM) ;Get progress note (WP) text for type 6 records
|
---|
| 218 | N ARRAY,LAST,NULL,SUB,TEXT,TXTCNT
|
---|
| 219 | S SUB=0
|
---|
| 220 | F S SUB=$O(^PXRMD(801.41,ITEM,35,SUB)) Q:'SUB D
|
---|
| 221 | .S ARRAY(SUB)=$G(^PXRMD(801.41,ITEM,35,SUB,0))
|
---|
| 222 | S SUB=0,LAST=0 F S SUB=$O(ARRAY(SUB)) Q:'SUB D
|
---|
| 223 | .S TEXT=$G(ARRAY(SUB))
|
---|
| 224 | .S NULL=0 I (TEXT="")!($E(TEXT)=" ") S NULL=1
|
---|
| 225 | .I LAST,'NULL S TEXT="<br>"_TEXT
|
---|
| 226 | .S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
|
---|
| 227 | .S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
|
---|
| 228 | .S OCNT=OCNT+1,ORY(OCNT)=6_U_ITEM_U_U_TEXT
|
---|
| 229 | Q
|
---|
| 230 | ;
|
---|
| 231 | TOK(TIEN,TYPE) ;Check if selectable codes exist
|
---|
| 232 | N DATA,FOUND,SUB
|
---|
| 233 | S FOUND=0,SUB=0
|
---|
| 234 | F S SUB=$O(^PXD(811.2,TIEN,TYPE,SUB)) Q:'SUB D Q:FOUND
|
---|
| 235 | .S DATA=$G(^PXD(811.2,TIEN,TYPE,SUB,0)) Q:DATA=""
|
---|
| 236 | .;Ignore disabled codes
|
---|
| 237 | .I '$P(DATA,U,3) S FOUND=1
|
---|
| 238 | Q FOUND
|
---|