- PXRMDLLA ;SLC/PJH - REMINDER DIALOG LOADER ;Mar 21, 2022@15:21:03
- ;;2.0;CLINICAL REMINDERS;**6,12,18,26,45,65**;Feb 04, 2005;Build 438
- ; ICR API/FILE
- ; 3112 ^GMRD(120.51,
- ; 2263 $$GET^XPAR
- ;
- EXECLINK(DITEM,VALUE,ID) ;
- N DONE,FILE,FIELD,FIND,FINDS,HASVALUE,I,LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
- N NODE,NUM,PAT,PKG,OVALUE,PROMPT,PMPTTYPE,RESULT,RTN,SUB,VAL
- S NUM=0 F S NUM=$O(^PXRMD(801.41,DITEM,10,NUM)) Q:NUM'>0 D
- . S LINK=$G(^PXRMD(801.41,DITEM,10,NUM,"LINK"))
- . I LINK=""!(+LINK'>0)!(+$P(LINK,U,2)'=1) Q
- . D GETLINK^PXRMDLLB(+LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
- . I $P(LINKACT,U)'="" Q
- . I LINKTYPE="ELEMENT" Q
- . S FIND=$P($G(^PXRMD(801.41,+LINKITEM,1)),U,5)
- . I FIND'[801.46 Q
- . S NODE=$G(^PXRMD(801.46,+FIND,0))
- . S PMPTTYPE=$P($G(^PXRMD(801.46,+FIND,2)),U) I PMPTTYPE'>0 Q
- . I $P($G(^PXRMD(801.42,PMPTTYPE,0)),U)'=LINKTYPE Q
- . S PKG=$P(NODE,U,2)
- . ;S PKG=$$EXTERNAL^DILFD(801.46,2,"",$P(NODE,U,2))
- . S FILE=$P(NODE,U,3),FIELD=$P($G(^PXRMD(801.46,+FIND,2)),U,2)
- . ;I $D(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD)) Q
- . I $G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))'="" Q
- . S OVALUE=""
- . S RTN=$P($G(^PXRMD(801.47,LINKFUNC,0)),U,2,3) Q:$P(RTN,U)="" Q:$P(RTN,U,2)=""
- . S NUM=0 F S NUM=$O(^PXRMD(801.48,+LINK,2,NUM)) Q:NUM'>0 D
- . .S NODE=$G(^PXRMD(801.48,+LINK,2,+NUM,0)),SUB=$P(NODE,U),VAL=$P(NODE,U,2) Q:SUB="" Q:VAL=""
- . .S INPUTS(SUB)=VAL
- . S PAT=0
- . S TEMP="S RET=$$"_RTN_"(.RESULT,PAT,VALUE,OVALUE,.INPUTS)"
- . X TEMP
- . I LINKFUNC>0,RESULT="" Q
- . S ^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID)=RESULT
- Q
- ;
- FREC(DFIEN,DFTYP,DITEM,PTDEF,DLGIEN,NDATA) ;Build type 3 record
- N CSARRAY,CSCNT
- N ARRAY,DATANODE,DCAP,DGUI,DFN,NODE,PRINT,OINAME,STATUS,START,STOP
- S PRINT=$S($P($G(^PXRMD(801.41,DLGIEN,"DATA")),U,3)=1:1,1:0)
- ;Dialog type/text and resolution
- S DNAM=$$NAME(DFIEN,DFTYP)
- ;Translate vitals ien to PCE code - This will need a DBIA
- S DCOD=""
- I DPCE="VIT" D
- .S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
- .;Vitals Caption
- .S DVIT=$P($G(^PXRMD(801.41,DITEM,2)),U,4)
- I DFTYP]"" D
- .S OCNT=OCNT+1
- .S ORY(OCNT)=3_U_DITEM_U_U_DPCE_U_DEXC_U_DFIEN_U_$G(DCOD)_U_DNAM_U_U_DVIT
- .;Get order type for orderable items
- .;DBIA #3110
- .S:DPCE="Q" $P(ORY(OCNT),U,11)=$P($G(^ORD(101.41,DFIEN,0)),U,4)
- .;If mental health check if a GAF score and if MH test is required
- .I DPCE="MH",DFIEN D
- ..;DBIA #5044
- ..I $P($G(^YTT(601.71,DFIEN,0)),U)="GAF" S $P(ORY(OCNT),U,12)=1
- ..;Check to see if the MH test is required
- ..S $P(ORY(OCNT),U,13)=+$P($G(^PXRMD(801.41,DITEM,0)),U,18)
- ..I $P(ORY(OCNT),U,13)=2,$$PATCH^XPDUTL("OR*3.0*243")=0 S $P(ORY(OCNT),U,13)=1
- .;
- .I DPCE="IMM"!(DPCE="SK") D
- ..S DCAP=$P($G(^PXRMD(801.41,DITEM,2)),U,4)
- ..;S $P(ORY(OCNT),U,10)=DCAP
- ..S $P(ORY(OCNT),U,10)=$$CTRL^XMXUTIL1(DCAP)
- ..S $P(ORY(OCNT),U,13)=+$P($G(^PXRMD(801.41,DITEM,"DATA")),U,4)
- .S DATANODE=$G(^PXRMD(801.41,DITEM,"DATA"))
- .;S $P(ORY(OCNT),U,16)=+$P(DATANODE,U,2)
- .S $P(ORY(OCNT),U,16)=+NDATA
- .S $P(ORY(OCNT),U,17)=$P(DATANODE,U)
- .S $P(ORY(OCNT),U,18)=$S($P(^PXRMD(801.41,DITEM,0),U,16)="IMMREAD":1,1:0)
- .;
- .I DPCE="GFIND" D
- ..N FILE,FIELD,ID,NODE,PKGNAME,VALUE,MULVAL,EXIT
- ..;N CID,NDATA,TYPE,VALUE,X
- ..N CID,TYPE,VALUE,X
- ..S NODE(0)=$G(^PXRMD(801.46,DFIEN,0)),NODE(2)=$G(^(2)),NODE(3)=$G(^(3))
- ..S PKG=$P(NODE(0),U,2)
- ..;S PKGNAME=$$EXTERNAL^DILFD(801.46,2,"",$P(NODE(0),U,2))
- ..S FILE=$P(NODE(0),U,3),MULVAL=$P(NODE(3),U)
- ..;S NDATA=+$P(DATANODE,U,2)
- ..F X=1,2 D
- ...S NODE(X)=$G(^PXRMD(801.46,DFIEN,X))
- ...S FIELD=$P(NODE(X),U,2)
- ...I X=1 S VALUE=$S('NDATA:$P(NODE(X),U),1:"")
- ...I FIELD="" Q
- ...I MULVAL="M",'NDATA D
- ....S ID="" F S ID=$O(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID)) Q:ID=""!($G(EXIT)) D
- .....I $G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))=VALUE S EXIT=ID
- ....I $G(EXIT) S ID=EXIT
- ...I MULVAL="S",'NDATA S ID=$O(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,""))
- ...;Exit Process: If mismatched values on edits
- ...I $G(ID)'="",X=1,$P(NODE(X),U)'="",$P(NODE(X),U)'=$G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID)) S $P(ORY(OCNT),U,14)=$G(ID) Q
- ...;Exit Process: If new values on edits
- ...I $G(ID)="",X=1,VALUE'="" S $P(ORY(OCNT),U,14)=$G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE)) Q
- ...;Exit Process: New record
- ...I $G(ID)="",VALUE="",X=1 Q
- ...I $G(ID)="",X=2 Q
- ...;
- ...S $P(ORY(OCNT),U,14)=$G(ID)
- ...S $P(ORY(OCNT),U,15)=$S($G(ID)'="":$G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID)),1:VALUE)
- ...;I $D(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE))=11 S ^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD)=$G(ID)
- ...;Set default prompt values to be accessed in PROTH line tag
- ...I $P(NODE(2),U)>0,'NDATA,$G(ID)'="" D
- ....S DGUI=$P($G(^PXRMD(801.42,$P(NODE(2),U),0)),U)
- ....I DGUI="GF_PRINT BUTTON",PRINT=0 Q
- ....;S PTDEF(DGUI)=$P(ORY(OCNT),U,15)
- ....S PTDEF(DGUI)=$G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))
- ...;
- ...I $P(ORY(OCNT),U,15)'="",$G(ID)'="" D EXECLINK(DITEM,$P(ORY(OCNT),U,15),ID)
- Q
- ;
- GUI(IEN) ;Work out prompt type for PCE
- Q:IEN="" ""
- N SUB S SUB=$P($G(^PXRMD(801.41,IEN,46)),U)
- Q:'SUB ""
- Q $P($G(^PXRMD(801.42,SUB,0)),U)
- ;
- LOAD(DITEM,DCUR,DTTYP,DLGIEN,NDATA) ;Load dialog questions into array
- N DARRAY,DCOD,DEXC,DFIND,DFIEN,DFTYP,DNAM,DPCE,DRES,DSEQ,DSUB,DTYP,OCNT
- N DVIT,MAGNODE,NODE,CNT,IDENT,TAXBUILT,TAXNODE,TDX,TPR,TSC,TSEL
- N PTDEF
- N RFVAL,ISIMM,ISSKT
- I +$G(DITEM)'>0 Q
- I $E($G(DLGIEN),1)="R" S DLGIEN=$P($G(^PXD(811.9,$P($G(DLGIEN),"R",2),51)),U)
- E S DLGIEN=$G(DLGIEN)
- S (ISIMM,ISSKT)=0
- ;DBIA #3110 OR(101.41
- ;
- ;Build list of PCE codes
- S DARRAY("AUTTEDT(")="PED"
- S DARRAY("AUTTEXAM(")="XAM"
- S DARRAY("AUTTHF(")="HF"
- S DARRAY("AUTTIMM(")="IMM"
- S DARRAY("AUTTSK(")="SK"
- ;
- S DARRAY("GMRD(120.51,")="VIT"
- S DARRAY("ORD(101.41,")="Q"
- S DARRAY("YTT(601.71,")="MH"
- ;
- S DARRAY("ICD9(")="POV"
- S DARRAY("ICPT(")="CPT"
- S DARRAY("WV(790.404,")="WH"
- S DARRAY("WV(790.1,")="WHR"
- S DARRAY("PXRMD(801.46,")="GFIND"
- ;
- S DARRAY("PXD(811.2,")="T"
- ;
- ;Get the dialog element
- S OCNT=0
- N TERMNODE,TERMSTAT,TERMOUT
- S DTYP=$P($G(^PXRMD(801.41,DITEM,0)),U,4)
- ;Finding detail
- S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
- S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
- ;check for WH finding
- I $P($G(^PXRMD(801.41,DITEM,0)),U,16)["WH" S DFIND=$G(WHFIND) K WHFIND
- ;
- S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
- S MAGNODE=""
- S DPCE="",DVIT="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
- ;Exclude from P/N
- S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
- ;
- ;Non taxonomy codes (3 - finding record)
- I DPCE="IMM" S ISIMM=1
- I DPCE="SK" S ISSKT=1
- S MAGNODE=$$GETMAG^PXRMDLG6(DFIEN,DFTYP)
- I DPCE'="T" D
- .D FREC(DFIEN,DFTYP,DITEM,.PTDEF,DLGIEN,.NDATA)
- .;S MAGNODE=$$GETMAG^PXRMDLG6(DFIEN,DFTYP)
- ;
- ;Taxonomy codes need expanding (3 - finding record)
- I DPCE="T" D
- .S TAXBUILT=0
- .I $G(DTTYP)="" D
- ..S TAXNODE=$G(^PXRMD(801.41,DITEM,"TAX"))
- ..S TSEL=$P(TAXNODE,U) I TSEL="N" Q
- ..S TDX=$$TOK^PXRMDTAX(DFIEN,"POV")
- ..S TPR=$$TOK^PXRMDTAX(DFIEN,"CPT")
- ..S TSC=$$TOK^PXRMDTAX(DFIEN,"SC")
- ..I TSEL="D" S DTTYP="POV",TAXBUILT=1 Q
- ..I TSEL="P" S DTTYP="CPT",TAXBUILT=1 Q
- ..I TSEL="S" S DTTYP="SC",TAXBUILT=1 Q
- ..I TDX,TPR,TSC Q
- ..I TDX,'TPR,'TSC S DTTYP="POV",TAXBUILT=1 Q
- ..I TPR,'TDX,'TSC S DTTYP="CPT",TAXBUILT=1 Q
- ..I TSC,'TDX,'TPR S DTTYP="SC",TAXBUILT=1 Q
- .I $G(DTTYP)'="" D EXP^PXRMDLLB(DITEM,DFIEN,DCUR,DTTYP,5,NDATA) I TAXBUILT=0 Q
- .D EXPTAX^PXRMDLLB(DITEM,DFIEN,DCUR,NDATA)
- ;
- ;AGP BEGIN MOVE OF ADD FINDINGS
- ;Additional findings
- N FASUB
- S FASUB=0
- F S FASUB=$O(^PXRMD(801.41,DITEM,3,FASUB)) Q:'FASUB D
- .;new DPCE here to keep the dialog prompts based off the finding item PCE value
- .N DPCE
- .S DFIND=$P($G(^PXRMD(801.41,DITEM,3,FASUB,0)),U)
- .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2) Q:DFTYP="" Q:DFIEN=""
- .S DVIT="",DPCE=$G(DARRAY(DFTYP))
- .I DPCE'="",DPCE'="T" D FREC(DFIEN,DFTYP,DITEM,.PTDEF,DLGIEN,NDATA)
- .I DPCE'="",DPCE="T" D
- ..D EXP^PXRMDLLB(DITEM,DFIEN,DCUR,"CPT",3,NDATA)
- ..D EXP^PXRMDLLB(DITEM,DFIEN,DCUR,"POV",3,NDATA)
- ..D EXP^PXRMDLLB(DITEM,DFIEN,DCUR,"SC",3,NDATA)
- ;;AGP END MOVE OF ADD FINDINGS
- ;
- ;Prompt details (4 - prompt records)
- N ARRAY,DTITLE,DREQ,DSEQ,DSSEQ,DSUB,DTYP
- ;If not a taxonomy get prompts from dialog file
- ;I DPCE'="T",'HASVIMM D PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE)
- I DPCE'="T",'ISSKT D PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE,ISIMM)
- ;Check for MST findings
- I (DPCE'="T"),(DFTYP]"") D MST^PXRMDLLB(DFTYP,DFIEN)
- ;If taxonomy use finding parameters (CPT/POV)
- I DPCE="T" D
- .I $G(DTTYP)="",$G(^PXRMD(801.41,DITEM,"TAX"))'="N" Q
- .I MAGNODE'="" D Q
- ..I $G(DTTYP)'="",$G(DCUR)'="" D PROTH(DITEM,DTTYP,DCUR,.PTDEF,DLGIEN,MAGNODE,0) Q
- ..D PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE,0)
- .I $D(^PXRMD(801.41,DITEM,10,"B"))>0 D Q
- ..I $G(DTTYP)'="",$G(DCUR)'="" D PROTH(DITEM,DTTYP,DCUR,.PTDEF,DLGIEN,MAGNODE,0) Q
- ..D PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE,0)
- ;Return array of type 4 records
- S DSEQ=""
- F S DSEQ=$O(ARRAY(DSEQ)) Q:'DSEQ D
- .S OCNT=OCNT+1
- .S ORY(OCNT)=4_U_DITEM_U_DSEQ_U_ARRAY(DSEQ)
- .S DSSEQ=""
- .S $P(ORY(OCNT),U,20)=$G(NDATA)
- .F S DSSEQ=$O(ARRAY(DSEQ,DSSEQ)) Q:'DSSEQ D
- ..S OCNT=OCNT+1
- ..S ORY(OCNT)=4_U_DITEM_U_DSEQ_"."_DSSEQ_U_ARRAY(DSEQ,DSSEQ)
- ..S $P(ORY(OCNT),U,20)=$G(NDATA)
- ;
- ;Get progress note text if defined
- ;Build Alternate progress note text for taxonomies with more then one pick list.
- I DTTYP="" D:'DEXC PTXT(DITEM,.NDATA)
- ;Build Alternate progress note text for taxonomies with one pick list.
- I DPCE="T",DTTYP'="" D:'DEXC PTXT(DITEM,.NDATA)
- Q
- ;
- ;Returns item name
- NAME(DFIEN,DFTYP) ;
- Q:DFTYP="" ""
- Q:DFIEN="" ""
- N NAME,FGLOB,POSN
- ;DBIA #4108
- I DFTYP="WV(790.404," S NAME=$P($G(^WV(790.404,DFIEN,0)),U) Q:NAME]"" NAME
- I DFTYP="WV(790.1," S NAME=$G(WHNAME) K WHNAME Q:NAME]"" NAME
- I DFTYP="PXRMD(801.46," S NAME=$P($G(^PXRMD(801.46,DFIEN,0)),U) Q:NAME]"" NAME
- S POSN=2
- S:DFTYP["AUTT" POSN=1 S:DFTYP["AUTTEDT" POSN=4 S:DFTYP["ICD" POSN=3
- S FGLOB=U_DFTYP_DFIEN_",0)",NAME=$P($G(@FGLOB),U,POSN)
- I (POSN>1),NAME="" S NAME=$P($G(@FGLOB),U)
- I NAME="" S NAME=DFIEN
- Q NAME
- ;
- PROTH(IEN,DTTYP,DCUR,PTDEF,DLGIEN,MAGNODE,ISIMM) ; Additional prompts defined in 801.41
- N CANSHOW,DDATA,DDEF,DIEN,DEXC,DGUI,DNAME,DOVR,DREQ,DSEQ,DSNL,DSUB,DFTEXT
- N DTXT,DTYP,EVENT,NODE,PRINT,PRINTTYP,SRV,TAX,DVALID
- N LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
- I MAGNODE'="" D
- .S DSEQ=$O(^PXRMD(801.41,IEN,10,"B",""),-1)+1
- .S ARRAY(DSEQ)="UCUM"_U_0_U_""_U_"P"_U_$P(MAGNODE,U,5)_U_1_U_1
- .S $P(ARRAY(DSEQ),U,27)=MAGNODE
- S NODE=$G(^PXRMD(801.41,DLGIEN,"DATA"))
- S CANSHOW=$S($P(NODE,U,3)="D":0,$P(NODE,U,3)="":0,1:1)
- S PRINTTYP=$P(NODE,U,3)
- I CANSHOW=0!(PRINTTYP="S") S PRINTTYP="N"
- ;
- S DSEQ=0
- F S DSEQ=$O(^PXRMD(801.41,IEN,10,"B",DSEQ)) Q:'DSEQ D
- .;Get prompts in sequence
- .S DSUB=$O(^PXRMD(801.41,IEN,10,"B",DSEQ,"")) Q:'DSUB
- .S NODE=$G(^PXRMD(801.41,IEN,10,DSUB,0))
- .S EVENT=$S($P(NODE,U,14)'="":$P(NODE,U,14),1:"C")
- .;Quit is prompt is marked disable
- .I $P(NODE,U,13)=1 Q
- .K LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
- .S LINK=$G(^PXRMD(801.41,IEN,10,DSUB,"LINK")) I +LINK>0 D GETLINK^PXRMDLLB(+LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
- .;Prompt ien
- .S DIEN=$P($G(^PXRMD(801.41,IEN,10,DSUB,0)),U,2) Q:'DIEN
- .;Ignore disabled components, and those that are not prompts
- .I $$ISDISAB^PXRMDLL(DIEN)=1 Q
- .Q:"PF"'[$P($G(^PXRMD(801.41,DIEN,0)),U,4)
- .;I ISIMM,$P($G(^PXRMD(801.41,DIEN,0)),U,4)'="F" Q
- .;check to make sure prompt is apporiate for the taxonomy encounter type
- .I $G(DTTYP)'="",$G(DCUR)'="",$$TAXPRMPT(DIEN,DTTYP,DCUR)=0 Q
- .;Set defaults to null
- .S DDEF="",DEXC="",DREQ="",DSNL=""
- .;Prompt name and GUI process (quit if null)
- .S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U),DGUI=$$GUI(DIEN)
- .;I ISIMM,$P($G(^PXRMD(801.41,DIEN,0)),U,4)'="F" Q
- .I ISIMM,DGUI'="IMM_SER" Q
- .I DGUI="GF_PRINT",CANSHOW=0 Q
- .I $G(DGUI)="WH_NOT_PURP" D
- ..S SRV=$$GET1^DIQ(200,DUZ,29,"I")
- ..S PRINTTYP=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
- .;I DGUI="GF_VIEW",$G(PRINTTYP)="" S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM PRINT/VIEW BUTTON ACTION",1,"I")
- .I DGUI="GF_VIEW" S PRINTTYP="N"
- .;Type Prompt or Forced
- .S DTYP=$P($G(^PXRMD(801.41,DIEN,0)),U,4)
- .I "PF"[DTYP D
- ..;Required/Prompt caption
- ..S DDATA=$G(^PXRMD(801.41,DIEN,2)),DTXT=$P(DDATA,U,4)
- ..;Default value or forced value
- ..S:DTYP="P" DDEF=$P(DDATA,U) S:DTYP="F" DDEF=$P(DDATA,U,2)
- ..I ISIMM,DGUI="IMM_SER",DTYP="P" S DTYP="F"
- ..;Override caption/start new line/exclude PN from dialog file
- ..S DDATA=$G(^PXRMD(801.41,IEN,10,DSUB,0)),DREQ=$P(DDATA,U,9)
- ..S DOVR=$P(DDATA,U,6),DSNL=$P(DDATA,U,7),DEXC=$P(DDATA,U,8)
- ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
- ..;Convert date to fileman format
- ..I DGUI="VST_DATE",DDEF["T" S DDEF=$$DT^XLFDT()
- .I $G(DGUI)'="",$G(PTDEF(DGUI))'="" S DDEF=PTDEF(DGUI)
- .;I $G(RFVAL)'="" S DDEF=RFVAL K RFVAL
- .I DGUI="DATE" S DVALID=$P(NODE,U,11)
- .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_$G(DFTEXT)_U_$G(PRINTTYP)_U_$G(LINKITEM)_U_$G(LINKTYPE)_U_$G(DVALID)
- .S $P(ARRAY(DSEQ),U,25)=$P($G(LINKACT),U,2)
- .S $P(ARRAY(DSEQ),U,26)=EVENT
- .;
- .I DGUI="UCUM",MAGNODE'="" S $P(ARRAY(DSEQ),U,27)=$P(MAGNODE,U,1,4)_U_$P(MAGNODE,U,6)
- .;the following section add a comment prompt to the WH review of result
- .;section of the reminder dialog
- .I DGUI="WH_PAP_RESULT",DFTYP="WV(790.1,",DTYP="P" D
- ..N WHCNT,WHFLAG,WHNUM,WHLOOP
- ..S WHNUM=DSEQ+1,WHLOOP=0
- ..F WHLOOP=0 D
- ...S (WHCNT,WHFLAG)=0
- ...F S WHCNT=$O(^PXRMD(801.41,IEN,10,"B",WHCNT)) Q:'WHCNT!(WHFLAG=1) D
- ....I WHCNT=WHNUM S WHFLAG=1,WHNUM=WHNUM+1
- ...I WHFLAG=0 S WHLOOP=1
- ..S ARRAY(WHNUM)="COM"_U_U_U_"P"_U_"Comment:"_U_U_U
- .;Additional checkboxes
- .I DGUI="COM",DIEN>1 D
- ..N DSSEQ,DSUB,DTEXT
- ..S DSSEQ=0
- ..F S DSSEQ=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ)) Q:'DSSEQ D
- ...S DSUB=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ,"")) Q:'DSUB
- ...S DTEXT=$P($G(^PXRMD(801.41,DIEN,45,DSUB,0)),U,2) Q:DTEXT=""
- ...S ARRAY(DSEQ,DSSEQ)=U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
- Q
- ;
- PRTAX(FNODE,RSUB) ;Get all additional fields for this resolution type
- N ACNT,ASUB
- N DDATA,DDEF,DEXC,DGUI,DNAME,DREQ,DSEQ,DSUB,DTYP,PRINT
- S ASUB=0,DSEQ=0
- F S ASUB=$O(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB)) Q:'ASUB D
- .S DDATA=$G(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB,0)) Q:DDATA=""
- .;Ignore if disabled
- .I $P(DDATA,U,3)=1 Q
- .S DSUB=$P(DDATA,U) Q:DDATA=""
- .S DSEQ=DSEQ+1
- .;Set defaults to null
- .S DDEF="",DEXC="",DREQ="",DSNL=""
- .;Prompt name and GUI process (quit if null)
- .S DNAME=$P($G(^PXRMD(801.41,DSUB,0)),U),DGUI=$$GUI(DSUB)
- .I $G(DGUI)="WH_NOT_PURP" D
- ..S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
- .;Type Prompt or Forced
- .S DTYP=$P($G(^PXRMD(801.41,DSUB,0)),U,4)
- .I DTYP="P" D
- ..S DREQ=$P(DDATA,U,2),DTXT=$P($G(^PXRMD(801.41,DSUB,2)),U,4)
- ..;Override caption/start new line/exclude from PN from finding type
- ..S DOVR=$P(DDATA,U,5),DSNL=$P(DDATA,U,6),DEXC=$P(DDATA,U,7)
- ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
- ..;Required/Prompt caption
- ..S DDATA=$G(^PXRMD(801.41,DSUB,2))
- .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_U_$G(PRINT)
- Q
- ;
- PTXT(ITEM,NDATA) ;Get progress note (WP) text for type 6 records
- N ARRAY,LAST,NULL,SUB,TEXT,TXTCNT
- S SUB=0
- F S SUB=$O(^PXRMD(801.41,ITEM,35,SUB)) Q:'SUB D
- .S ARRAY(SUB)=$G(^PXRMD(801.41,ITEM,35,SUB,0))
- S SUB=0,LAST=0 F S SUB=$O(ARRAY(SUB)) Q:'SUB D
- .S TEXT=$G(ARRAY(SUB))
- .S NULL=0 I (TEXT="")!($E(TEXT)=" ") S NULL=1
- .I LAST,'NULL S TEXT="<br>"_TEXT
- .S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
- .S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
- .S OCNT=OCNT+1,ORY(OCNT)=6_U_ITEM_U_U_TEXT_U_$G(NDATA)
- Q
- ;
- ;function to determine if the prompt is valid for the taxonomy encounter type.
- TAXPRMPT(DIEN,DTTYP,DCUR) ;
- N FIND,IEN
- S IEN=$P($G(^PXRMD(801.41,DIEN,1)),U,4) I +IEN=0 Q 1
- S FIND=$P($G(^PXRMD(801.45,IEN,0)),U) I FIND="" Q 1
- I FIND=DTTYP Q 1
- Q 0
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLLA 16255 printed Feb 18, 2025@23:10:26 Page 2
- PXRMDLLA ;SLC/PJH - REMINDER DIALOG LOADER ;Mar 21, 2022@15:21:03
- +1 ;;2.0;CLINICAL REMINDERS;**6,12,18,26,45,65**;Feb 04, 2005;Build 438
- +2 ; ICR API/FILE
- +3 ; 3112 ^GMRD(120.51,
- +4 ; 2263 $$GET^XPAR
- +5 ;
- EXECLINK(DITEM,VALUE,ID) ;
- +1 NEW DONE,FILE,FIELD,FIND,FINDS,HASVALUE,I,LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
- +2 NEW NODE,NUM,PAT,PKG,OVALUE,PROMPT,PMPTTYPE,RESULT,RTN,SUB,VAL
- +3 SET NUM=0
- FOR
- SET NUM=$ORDER(^PXRMD(801.41,DITEM,10,NUM))
- if NUM'>0
- QUIT
- Begin DoDot:1
- +4 SET LINK=$GET(^PXRMD(801.41,DITEM,10,NUM,"LINK"))
- +5 IF LINK=""!(+LINK'>0)!(+$PIECE(LINK,U,2)'=1)
- QUIT
- +6 DO GETLINK^PXRMDLLB(+LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
- +7 IF $PIECE(LINKACT,U)'=""
- QUIT
- +8 IF LINKTYPE="ELEMENT"
- QUIT
- +9 SET FIND=$PIECE($GET(^PXRMD(801.41,+LINKITEM,1)),U,5)
- +10 IF FIND'[801.46
- QUIT
- +11 SET NODE=$GET(^PXRMD(801.46,+FIND,0))
- +12 SET PMPTTYPE=$PIECE($GET(^PXRMD(801.46,+FIND,2)),U)
- IF PMPTTYPE'>0
- QUIT
- +13 IF $PIECE($GET(^PXRMD(801.42,PMPTTYPE,0)),U)'=LINKTYPE
- QUIT
- +14 SET PKG=$PIECE(NODE,U,2)
- +15 ;S PKG=$$EXTERNAL^DILFD(801.46,2,"",$P(NODE,U,2))
- +16 SET FILE=$PIECE(NODE,U,3)
- SET FIELD=$PIECE($GET(^PXRMD(801.46,+FIND,2)),U,2)
- +17 ;I $D(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD)) Q
- +18 IF $GET(^TMP($JOB,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))'=""
- QUIT
- +19 SET OVALUE=""
- +20 SET RTN=$PIECE($GET(^PXRMD(801.47,LINKFUNC,0)),U,2,3)
- if $PIECE(RTN,U)=""
- QUIT
- if $PIECE(RTN,U,2)=""
- QUIT
- +21 SET NUM=0
- FOR
- SET NUM=$ORDER(^PXRMD(801.48,+LINK,2,NUM))
- if NUM'>0
- QUIT
- Begin DoDot:2
- +22 SET NODE=$GET(^PXRMD(801.48,+LINK,2,+NUM,0))
- SET SUB=$PIECE(NODE,U)
- SET VAL=$PIECE(NODE,U,2)
- if SUB=""
- QUIT
- if VAL=""
- QUIT
- +23 SET INPUTS(SUB)=VAL
- End DoDot:2
- +24 SET PAT=0
- +25 SET TEMP="S RET=$$"_RTN_"(.RESULT,PAT,VALUE,OVALUE,.INPUTS)"
- +26 XECUTE TEMP
- +27 IF LINKFUNC>0
- IF RESULT=""
- QUIT
- +28 SET ^TMP($JOB,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID)=RESULT
- End DoDot:1
- +29 QUIT
- +30 ;
- FREC(DFIEN,DFTYP,DITEM,PTDEF,DLGIEN,NDATA) ;Build type 3 record
- +1 NEW CSARRAY,CSCNT
- +2 NEW ARRAY,DATANODE,DCAP,DGUI,DFN,NODE,PRINT,OINAME,STATUS,START,STOP
- +3 SET PRINT=$SELECT($PIECE($GET(^PXRMD(801.41,DLGIEN,"DATA")),U,3)=1:1,1:0)
- +4 ;Dialog type/text and resolution
- +5 SET DNAM=$$NAME(DFIEN,DFTYP)
- +6 ;Translate vitals ien to PCE code - This will need a DBIA
- +7 SET DCOD=""
- +8 IF DPCE="VIT"
- Begin DoDot:1
- +9 SET DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
- +10 ;Vitals Caption
- +11 SET DVIT=$PIECE($GET(^PXRMD(801.41,DITEM,2)),U,4)
- End DoDot:1
- +12 IF DFTYP]""
- Begin DoDot:1
- +13 SET OCNT=OCNT+1
- +14 SET ORY(OCNT)=3_U_DITEM_U_U_DPCE_U_DEXC_U_DFIEN_U_$GET(DCOD)_U_DNAM_U_U_DVIT
- +15 ;Get order type for orderable items
- +16 ;DBIA #3110
- +17 if DPCE="Q"
- SET $PIECE(ORY(OCNT),U,11)=$PIECE($GET(^ORD(101.41,DFIEN,0)),U,4)
- +18 ;If mental health check if a GAF score and if MH test is required
- +19 IF DPCE="MH"
- IF DFIEN
- Begin DoDot:2
- +20 ;DBIA #5044
- +21 IF $PIECE($GET(^YTT(601.71,DFIEN,0)),U)="GAF"
- SET $PIECE(ORY(OCNT),U,12)=1
- +22 ;Check to see if the MH test is required
- +23 SET $PIECE(ORY(OCNT),U,13)=+$PIECE($GET(^PXRMD(801.41,DITEM,0)),U,18)
- +24 IF $PIECE(ORY(OCNT),U,13)=2
- IF $$PATCH^XPDUTL("OR*3.0*243")=0
- SET $PIECE(ORY(OCNT),U,13)=1
- End DoDot:2
- +25 ;
- +26 IF DPCE="IMM"!(DPCE="SK")
- Begin DoDot:2
- +27 SET DCAP=$PIECE($GET(^PXRMD(801.41,DITEM,2)),U,4)
- +28 ;S $P(ORY(OCNT),U,10)=DCAP
- +29 SET $PIECE(ORY(OCNT),U,10)=$$CTRL^XMXUTIL1(DCAP)
- +30 SET $PIECE(ORY(OCNT),U,13)=+$PIECE($GET(^PXRMD(801.41,DITEM,"DATA")),U,4)
- End DoDot:2
- +31 SET DATANODE=$GET(^PXRMD(801.41,DITEM,"DATA"))
- +32 ;S $P(ORY(OCNT),U,16)=+$P(DATANODE,U,2)
- +33 SET $PIECE(ORY(OCNT),U,16)=+NDATA
- +34 SET $PIECE(ORY(OCNT),U,17)=$PIECE(DATANODE,U)
- +35 SET $PIECE(ORY(OCNT),U,18)=$SELECT($PIECE(^PXRMD(801.41,DITEM,0),U,16)="IMMREAD":1,1:0)
- +36 ;
- +37 IF DPCE="GFIND"
- Begin DoDot:2
- +38 NEW FILE,FIELD,ID,NODE,PKGNAME,VALUE,MULVAL,EXIT
- +39 ;N CID,NDATA,TYPE,VALUE,X
- +40 NEW CID,TYPE,VALUE,X
- +41 SET NODE(0)=$GET(^PXRMD(801.46,DFIEN,0))
- SET NODE(2)=$GET(^(2))
- SET NODE(3)=$GET(^(3))
- +42 SET PKG=$PIECE(NODE(0),U,2)
- +43 ;S PKGNAME=$$EXTERNAL^DILFD(801.46,2,"",$P(NODE(0),U,2))
- +44 SET FILE=$PIECE(NODE(0),U,3)
- SET MULVAL=$PIECE(NODE(3),U)
- +45 ;S NDATA=+$P(DATANODE,U,2)
- +46 FOR X=1,2
- Begin DoDot:3
- +47 SET NODE(X)=$GET(^PXRMD(801.46,DFIEN,X))
- +48 SET FIELD=$PIECE(NODE(X),U,2)
- +49 IF X=1
- SET VALUE=$SELECT('NDATA:$PIECE(NODE(X),U),1:"")
- +50 IF FIELD=""
- QUIT
- +51 IF MULVAL="M"
- IF 'NDATA
- Begin DoDot:4
- +52 SET ID=""
- FOR
- SET ID=$ORDER(^TMP($JOB,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))
- if ID=""!($GET(EXIT))
- QUIT
- Begin DoDot:5
- +53 IF $GET(^TMP($JOB,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))=VALUE
- SET EXIT=ID
- End DoDot:5
- +54 IF $GET(EXIT)
- SET ID=EXIT
- End DoDot:4
- +55 IF MULVAL="S"
- IF 'NDATA
- SET ID=$ORDER(^TMP($JOB,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,""))
- +56 ;Exit Process: If mismatched values on edits
- +57 IF $GET(ID)'=""
- IF X=1
- IF $PIECE(NODE(X),U)'=""
- IF $PIECE(NODE(X),U)'=$GET(^TMP($JOB,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))
- SET $PIECE(ORY(OCNT),U,14)=$GET(ID)
- QUIT
- +58 ;Exit Process: If new values on edits
- +59 IF $GET(ID)=""
- IF X=1
- IF VALUE'=""
- SET $PIECE(ORY(OCNT),U,14)=$GET(^TMP($JOB,"PXRM GEN FINDING",DLGIEN,PKG,FILE))
- QUIT
- +60 ;Exit Process: New record
- +61 IF $GET(ID)=""
- IF VALUE=""
- IF X=1
- QUIT
- +62 IF $GET(ID)=""
- IF X=2
- QUIT
- +63 ;
- +64 SET $PIECE(ORY(OCNT),U,14)=$GET(ID)
- +65 SET $PIECE(ORY(OCNT),U,15)=$SELECT($GET(ID)'="":$GET(^TMP($JOB,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID)),1:VALUE)
- +66 ;I $D(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE))=11 S ^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD)=$G(ID)
- +67 ;Set default prompt values to be accessed in PROTH line tag
- +68 IF $PIECE(NODE(2),U)>0
- IF 'NDATA
- IF $GET(ID)'=""
- Begin DoDot:4
- +69 SET DGUI=$PIECE($GET(^PXRMD(801.42,$PIECE(NODE(2),U),0)),U)
- +70 IF DGUI="GF_PRINT BUTTON"
- IF PRINT=0
- QUIT
- +71 ;S PTDEF(DGUI)=$P(ORY(OCNT),U,15)
- +72 SET PTDEF(DGUI)=$GET(^TMP($JOB,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))
- End DoDot:4
- +73 ;
- +74 IF $PIECE(ORY(OCNT),U,15)'=""
- IF $GET(ID)'=""
- DO EXECLINK(DITEM,$PIECE(ORY(OCNT),U,15),ID)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +75 QUIT
- +76 ;
- GUI(IEN) ;Work out prompt type for PCE
- +1 if IEN=""
- QUIT ""
- +2 NEW SUB
- SET SUB=$PIECE($GET(^PXRMD(801.41,IEN,46)),U)
- +3 if 'SUB
- QUIT ""
- +4 QUIT $PIECE($GET(^PXRMD(801.42,SUB,0)),U)
- +5 ;
- LOAD(DITEM,DCUR,DTTYP,DLGIEN,NDATA) ;Load dialog questions into array
- +1 NEW DARRAY,DCOD,DEXC,DFIND,DFIEN,DFTYP,DNAM,DPCE,DRES,DSEQ,DSUB,DTYP,OCNT
- +2 NEW DVIT,MAGNODE,NODE,CNT,IDENT,TAXBUILT,TAXNODE,TDX,TPR,TSC,TSEL
- +3 NEW PTDEF
- +4 NEW RFVAL,ISIMM,ISSKT
- +5 IF +$GET(DITEM)'>0
- QUIT
- +6 IF $EXTRACT($GET(DLGIEN),1)="R"
- SET DLGIEN=$PIECE($GET(^PXD(811.9,$PIECE($GET(DLGIEN),"R",2),51)),U)
- +7 IF '$TEST
- SET DLGIEN=$GET(DLGIEN)
- +8 SET (ISIMM,ISSKT)=0
- +9 ;DBIA #3110 OR(101.41
- +10 ;
- +11 ;Build list of PCE codes
- +12 SET DARRAY("AUTTEDT(")="PED"
- +13 SET DARRAY("AUTTEXAM(")="XAM"
- +14 SET DARRAY("AUTTHF(")="HF"
- +15 SET DARRAY("AUTTIMM(")="IMM"
- +16 SET DARRAY("AUTTSK(")="SK"
- +17 ;
- +18 SET DARRAY("GMRD(120.51,")="VIT"
- +19 SET DARRAY("ORD(101.41,")="Q"
- +20 SET DARRAY("YTT(601.71,")="MH"
- +21 ;
- +22 SET DARRAY("ICD9(")="POV"
- +23 SET DARRAY("ICPT(")="CPT"
- +24 SET DARRAY("WV(790.404,")="WH"
- +25 SET DARRAY("WV(790.1,")="WHR"
- +26 SET DARRAY("PXRMD(801.46,")="GFIND"
- +27 ;
- +28 SET DARRAY("PXD(811.2,")="T"
- +29 ;
- +30 ;Get the dialog element
- +31 SET OCNT=0
- +32 NEW TERMNODE,TERMSTAT,TERMOUT
- +33 SET DTYP=$PIECE($GET(^PXRMD(801.41,DITEM,0)),U,4)
- +34 ;Finding detail
- +35 SET DRES=$PIECE($GET(^PXRMD(801.41,DITEM,1)),U,3)
- +36 SET DFIND=$PIECE($GET(^PXRMD(801.41,DITEM,1)),U,5)
- +37 ;check for WH finding
- +38 IF $PIECE($GET(^PXRMD(801.41,DITEM,0)),U,16)["WH"
- SET DFIND=$GET(WHFIND)
- KILL WHFIND
- +39 ;
- +40 SET DFIEN=$PIECE(DFIND,";")
- SET DFTYP=$PIECE(DFIND,";",2)
- +41 SET MAGNODE=""
- +42 SET DPCE=""
- SET DVIT=""
- IF DFTYP'=""
- SET DPCE=$GET(DARRAY(DFTYP))
- +43 ;Exclude from P/N
- +44 SET DEXC=$PIECE($GET(^PXRMD(801.41,DITEM,2)),U,3)
- +45 ;
- +46 ;Non taxonomy codes (3 - finding record)
- +47 IF DPCE="IMM"
- SET ISIMM=1
- +48 IF DPCE="SK"
- SET ISSKT=1
- +49 SET MAGNODE=$$GETMAG^PXRMDLG6(DFIEN,DFTYP)
- +50 IF DPCE'="T"
- Begin DoDot:1
- +51 DO FREC(DFIEN,DFTYP,DITEM,.PTDEF,DLGIEN,.NDATA)
- +52 ;S MAGNODE=$$GETMAG^PXRMDLG6(DFIEN,DFTYP)
- End DoDot:1
- +53 ;
- +54 ;Taxonomy codes need expanding (3 - finding record)
- +55 IF DPCE="T"
- Begin DoDot:1
- +56 SET TAXBUILT=0
- +57 IF $GET(DTTYP)=""
- Begin DoDot:2
- +58 SET TAXNODE=$GET(^PXRMD(801.41,DITEM,"TAX"))
- +59 SET TSEL=$PIECE(TAXNODE,U)
- IF TSEL="N"
- QUIT
- +60 SET TDX=$$TOK^PXRMDTAX(DFIEN,"POV")
- +61 SET TPR=$$TOK^PXRMDTAX(DFIEN,"CPT")
- +62 SET TSC=$$TOK^PXRMDTAX(DFIEN,"SC")
- +63 IF TSEL="D"
- SET DTTYP="POV"
- SET TAXBUILT=1
- QUIT
- +64 IF TSEL="P"
- SET DTTYP="CPT"
- SET TAXBUILT=1
- QUIT
- +65 IF TSEL="S"
- SET DTTYP="SC"
- SET TAXBUILT=1
- QUIT
- +66 IF TDX
- IF TPR
- IF TSC
- QUIT
- +67 IF TDX
- IF 'TPR
- IF 'TSC
- SET DTTYP="POV"
- SET TAXBUILT=1
- QUIT
- +68 IF TPR
- IF 'TDX
- IF 'TSC
- SET DTTYP="CPT"
- SET TAXBUILT=1
- QUIT
- +69 IF TSC
- IF 'TDX
- IF 'TPR
- SET DTTYP="SC"
- SET TAXBUILT=1
- QUIT
- End DoDot:2
- +70 IF $GET(DTTYP)'=""
- DO EXP^PXRMDLLB(DITEM,DFIEN,DCUR,DTTYP,5,NDATA)
- IF TAXBUILT=0
- QUIT
- +71 DO EXPTAX^PXRMDLLB(DITEM,DFIEN,DCUR,NDATA)
- End DoDot:1
- +72 ;
- +73 ;AGP BEGIN MOVE OF ADD FINDINGS
- +74 ;Additional findings
- +75 NEW FASUB
- +76 SET FASUB=0
- +77 FOR
- SET FASUB=$ORDER(^PXRMD(801.41,DITEM,3,FASUB))
- if 'FASUB
- QUIT
- Begin DoDot:1
- +78 ;new DPCE here to keep the dialog prompts based off the finding item PCE value
- +79 NEW DPCE
- +80 SET DFIND=$PIECE($GET(^PXRMD(801.41,DITEM,3,FASUB,0)),U)
- +81 SET DFIEN=$PIECE(DFIND,";")
- SET DFTYP=$PIECE(DFIND,";",2)
- if DFTYP=""
- QUIT
- if DFIEN=""
- QUIT
- +82 SET DVIT=""
- SET DPCE=$GET(DARRAY(DFTYP))
- +83 IF DPCE'=""
- IF DPCE'="T"
- DO FREC(DFIEN,DFTYP,DITEM,.PTDEF,DLGIEN,NDATA)
- +84 IF DPCE'=""
- IF DPCE="T"
- Begin DoDot:2
- +85 DO EXP^PXRMDLLB(DITEM,DFIEN,DCUR,"CPT",3,NDATA)
- +86 DO EXP^PXRMDLLB(DITEM,DFIEN,DCUR,"POV",3,NDATA)
- +87 DO EXP^PXRMDLLB(DITEM,DFIEN,DCUR,"SC",3,NDATA)
- End DoDot:2
- End DoDot:1
- +88 ;;AGP END MOVE OF ADD FINDINGS
- +89 ;
- +90 ;Prompt details (4 - prompt records)
- +91 NEW ARRAY,DTITLE,DREQ,DSEQ,DSSEQ,DSUB,DTYP
- +92 ;If not a taxonomy get prompts from dialog file
- +93 ;I DPCE'="T",'HASVIMM D PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE)
- +94 IF DPCE'="T"
- IF 'ISSKT
- DO PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE,ISIMM)
- +95 ;Check for MST findings
- +96 IF (DPCE'="T")
- IF (DFTYP]"")
- DO MST^PXRMDLLB(DFTYP,DFIEN)
- +97 ;If taxonomy use finding parameters (CPT/POV)
- +98 IF DPCE="T"
- Begin DoDot:1
- +99 IF $GET(DTTYP)=""
- IF $GET(^PXRMD(801.41,DITEM,"TAX"))'="N"
- QUIT
- +100 IF MAGNODE'=""
- Begin DoDot:2
- +101 IF $GET(DTTYP)'=""
- IF $GET(DCUR)'=""
- DO PROTH(DITEM,DTTYP,DCUR,.PTDEF,DLGIEN,MAGNODE,0)
- QUIT
- +102 DO PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE,0)
- End DoDot:2
- QUIT
- +103 IF $DATA(^PXRMD(801.41,DITEM,10,"B"))>0
- Begin DoDot:2
- +104 IF $GET(DTTYP)'=""
- IF $GET(DCUR)'=""
- DO PROTH(DITEM,DTTYP,DCUR,.PTDEF,DLGIEN,MAGNODE,0)
- QUIT
- +105 DO PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE,0)
- End DoDot:2
- QUIT
- End DoDot:1
- +106 ;Return array of type 4 records
- +107 SET DSEQ=""
- +108 FOR
- SET DSEQ=$ORDER(ARRAY(DSEQ))
- if 'DSEQ
- QUIT
- Begin DoDot:1
- +109 SET OCNT=OCNT+1
- +110 SET ORY(OCNT)=4_U_DITEM_U_DSEQ_U_ARRAY(DSEQ)
- +111 SET DSSEQ=""
- +112 SET $PIECE(ORY(OCNT),U,20)=$GET(NDATA)
- +113 FOR
- SET DSSEQ=$ORDER(ARRAY(DSEQ,DSSEQ))
- if 'DSSEQ
- QUIT
- Begin DoDot:2
- +114 SET OCNT=OCNT+1
- +115 SET ORY(OCNT)=4_U_DITEM_U_DSEQ_"."_DSSEQ_U_ARRAY(DSEQ,DSSEQ)
- +116 SET $PIECE(ORY(OCNT),U,20)=$GET(NDATA)
- End DoDot:2
- End DoDot:1
- +117 ;
- +118 ;Get progress note text if defined
- +119 ;Build Alternate progress note text for taxonomies with more then one pick list.
- +120 IF DTTYP=""
- if 'DEXC
- DO PTXT(DITEM,.NDATA)
- +121 ;Build Alternate progress note text for taxonomies with one pick list.
- +122 IF DPCE="T"
- IF DTTYP'=""
- if 'DEXC
- DO PTXT(DITEM,.NDATA)
- +123 QUIT
- +124 ;
- +125 ;Returns item name
- NAME(DFIEN,DFTYP) ;
- +1 if DFTYP=""
- QUIT ""
- +2 if DFIEN=""
- QUIT ""
- +3 NEW NAME,FGLOB,POSN
- +4 ;DBIA #4108
- +5 IF DFTYP="WV(790.404,"
- SET NAME=$PIECE($GET(^WV(790.404,DFIEN,0)),U)
- if NAME]""
- QUIT NAME
- +6 IF DFTYP="WV(790.1,"
- SET NAME=$GET(WHNAME)
- KILL WHNAME
- if NAME]""
- QUIT NAME
- +7 IF DFTYP="PXRMD(801.46,"
- SET NAME=$PIECE($GET(^PXRMD(801.46,DFIEN,0)),U)
- if NAME]""
- QUIT NAME
- +8 SET POSN=2
- +9 if DFTYP["AUTT"
- SET POSN=1
- if DFTYP["AUTTEDT"
- SET POSN=4
- if DFTYP["ICD"
- SET POSN=3
- +10 SET FGLOB=U_DFTYP_DFIEN_",0)"
- SET NAME=$PIECE($GET(@FGLOB),U,POSN)
- +11 IF (POSN>1)
- IF NAME=""
- SET NAME=$PIECE($GET(@FGLOB),U)
- +12 IF NAME=""
- SET NAME=DFIEN
- +13 QUIT NAME
- +14 ;
- PROTH(IEN,DTTYP,DCUR,PTDEF,DLGIEN,MAGNODE,ISIMM) ; Additional prompts defined in 801.41
- +1 NEW CANSHOW,DDATA,DDEF,DIEN,DEXC,DGUI,DNAME,DOVR,DREQ,DSEQ,DSNL,DSUB,DFTEXT
- +2 NEW DTXT,DTYP,EVENT,NODE,PRINT,PRINTTYP,SRV,TAX,DVALID
- +3 NEW LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
- +4 IF MAGNODE'=""
- Begin DoDot:1
- +5 SET DSEQ=$ORDER(^PXRMD(801.41,IEN,10,"B",""),-1)+1
- +6 SET ARRAY(DSEQ)="UCUM"_U_0_U_""_U_"P"_U_$PIECE(MAGNODE,U,5)_U_1_U_1
- +7 SET $PIECE(ARRAY(DSEQ),U,27)=MAGNODE
- End DoDot:1
- +8 SET NODE=$GET(^PXRMD(801.41,DLGIEN,"DATA"))
- +9 SET CANSHOW=$SELECT($PIECE(NODE,U,3)="D":0,$PIECE(NODE,U,3)="":0,1:1)
- +10 SET PRINTTYP=$PIECE(NODE,U,3)
- +11 IF CANSHOW=0!(PRINTTYP="S")
- SET PRINTTYP="N"
- +12 ;
- +13 SET DSEQ=0
- +14 FOR
- SET DSEQ=$ORDER(^PXRMD(801.41,IEN,10,"B",DSEQ))
- if 'DSEQ
- QUIT
- Begin DoDot:1
- +15 ;Get prompts in sequence
- +16 SET DSUB=$ORDER(^PXRMD(801.41,IEN,10,"B",DSEQ,""))
- if 'DSUB
- QUIT
- +17 SET NODE=$GET(^PXRMD(801.41,IEN,10,DSUB,0))
- +18 SET EVENT=$SELECT($PIECE(NODE,U,14)'="":$PIECE(NODE,U,14),1:"C")
- +19 ;Quit is prompt is marked disable
- +20 IF $PIECE(NODE,U,13)=1
- QUIT
- +21 KILL LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
- +22 SET LINK=$GET(^PXRMD(801.41,IEN,10,DSUB,"LINK"))
- IF +LINK>0
- DO GETLINK^PXRMDLLB(+LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
- +23 ;Prompt ien
- +24 SET DIEN=$PIECE($GET(^PXRMD(801.41,IEN,10,DSUB,0)),U,2)
- if 'DIEN
- QUIT
- +25 ;Ignore disabled components, and those that are not prompts
- +26 IF $$ISDISAB^PXRMDLL(DIEN)=1
- QUIT
- +27 if "PF"'[$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)
- QUIT
- +28 ;I ISIMM,$P($G(^PXRMD(801.41,DIEN,0)),U,4)'="F" Q
- +29 ;check to make sure prompt is apporiate for the taxonomy encounter type
- +30 IF $GET(DTTYP)'=""
- IF $GET(DCUR)'=""
- IF $$TAXPRMPT(DIEN,DTTYP,DCUR)=0
- QUIT
- +31 ;Set defaults to null
- +32 SET DDEF=""
- SET DEXC=""
- SET DREQ=""
- SET DSNL=""
- +33 ;Prompt name and GUI process (quit if null)
- +34 SET DNAME=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)
- SET DGUI=$$GUI(DIEN)
- +35 ;I ISIMM,$P($G(^PXRMD(801.41,DIEN,0)),U,4)'="F" Q
- +36 IF ISIMM
- IF DGUI'="IMM_SER"
- QUIT
- +37 IF DGUI="GF_PRINT"
- IF CANSHOW=0
- QUIT
- +38 IF $GET(DGUI)="WH_NOT_PURP"
- Begin DoDot:2
- +39 SET SRV=$$GET1^DIQ(200,DUZ,29,"I")
- +40 SET PRINTTYP=$$GET^XPAR($GET(DUZ)_";VA(200,^SRV.`"_+$GET(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
- End DoDot:2
- +41 ;I DGUI="GF_VIEW",$G(PRINTTYP)="" S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM PRINT/VIEW BUTTON ACTION",1,"I")
- +42 IF DGUI="GF_VIEW"
- SET PRINTTYP="N"
- +43 ;Type Prompt or Forced
- +44 SET DTYP=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)
- +45 IF "PF"[DTYP
- Begin DoDot:2
- +46 ;Required/Prompt caption
- +47 SET DDATA=$GET(^PXRMD(801.41,DIEN,2))
- SET DTXT=$PIECE(DDATA,U,4)
- +48 ;Default value or forced value
- +49 if DTYP="P"
- SET DDEF=$PIECE(DDATA,U)
- if DTYP="F"
- SET DDEF=$PIECE(DDATA,U,2)
- +50 IF ISIMM
- IF DGUI="IMM_SER"
- IF DTYP="P"
- SET DTYP="F"
- +51 ;Override caption/start new line/exclude PN from dialog file
- +52 SET DDATA=$GET(^PXRMD(801.41,IEN,10,DSUB,0))
- SET DREQ=$PIECE(DDATA,U,9)
- +53 SET DOVR=$PIECE(DDATA,U,6)
- SET DSNL=$PIECE(DDATA,U,7)
- SET DEXC=$PIECE(DDATA,U,8)
- +54 SET DNAME=DTXT
- IF DOVR]""
- SET DNAME=DOVR
- +55 ;Convert date to fileman format
- +56 IF DGUI="VST_DATE"
- IF DDEF["T"
- SET DDEF=$$DT^XLFDT()
- End DoDot:2
- +57 IF $GET(DGUI)'=""
- IF $GET(PTDEF(DGUI))'=""
- SET DDEF=PTDEF(DGUI)
- +58 ;I $G(RFVAL)'="" S DDEF=RFVAL K RFVAL
- +59 IF DGUI="DATE"
- SET DVALID=$PIECE(NODE,U,11)
- +60 SET ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_$GET(DFTEXT)_U_$GET(PRINTTYP)_U_$GET(LINKITEM)_U_$GET(LINKTYPE)_U_$GET(DVALID)
- +61 SET $PIECE(ARRAY(DSEQ),U,25)=$PIECE($GET(LINKACT),U,2)
- +62 SET $PIECE(ARRAY(DSEQ),U,26)=EVENT
- +63 ;
- +64 IF DGUI="UCUM"
- IF MAGNODE'=""
- SET $PIECE(ARRAY(DSEQ),U,27)=$PIECE(MAGNODE,U,1,4)_U_$PIECE(MAGNODE,U,6)
- +65 ;the following section add a comment prompt to the WH review of result
- +66 ;section of the reminder dialog
- +67 IF DGUI="WH_PAP_RESULT"
- IF DFTYP="WV(790.1,"
- IF DTYP="P"
- Begin DoDot:2
- +68 NEW WHCNT,WHFLAG,WHNUM,WHLOOP
- +69 SET WHNUM=DSEQ+1
- SET WHLOOP=0
- +70 FOR WHLOOP=0
- Begin DoDot:3
- +71 SET (WHCNT,WHFLAG)=0
- +72 FOR
- SET WHCNT=$ORDER(^PXRMD(801.41,IEN,10,"B",WHCNT))
- if 'WHCNT!(WHFLAG=1)
- QUIT
- Begin DoDot:4
- +73 IF WHCNT=WHNUM
- SET WHFLAG=1
- SET WHNUM=WHNUM+1
- End DoDot:4
- +74 IF WHFLAG=0
- SET WHLOOP=1
- End DoDot:3
- +75 SET ARRAY(WHNUM)="COM"_U_U_U_"P"_U_"Comment:"_U_U_U
- End DoDot:2
- +76 ;Additional checkboxes
- +77 IF DGUI="COM"
- IF DIEN>1
- Begin DoDot:2
- +78 NEW DSSEQ,DSUB,DTEXT
- +79 SET DSSEQ=0
- +80 FOR
- SET DSSEQ=$ORDER(^PXRMD(801.41,DIEN,45,"B",DSSEQ))
- if 'DSSEQ
- QUIT
- Begin DoDot:3
- +81 SET DSUB=$ORDER(^PXRMD(801.41,DIEN,45,"B",DSSEQ,""))
- if 'DSUB
- QUIT
- +82 SET DTEXT=$PIECE($GET(^PXRMD(801.41,DIEN,45,DSUB,0)),U,2)
- if DTEXT=""
- QUIT
- +83 SET ARRAY(DSEQ,DSSEQ)=U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +84 QUIT
- +85 ;
- PRTAX(FNODE,RSUB) ;Get all additional fields for this resolution type
- +1 NEW ACNT,ASUB
- +2 NEW DDATA,DDEF,DEXC,DGUI,DNAME,DREQ,DSEQ,DSUB,DTYP,PRINT
- +3 SET ASUB=0
- SET DSEQ=0
- +4 FOR
- SET ASUB=$ORDER(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB))
- if 'ASUB
- QUIT
- Begin DoDot:1
- +5 SET DDATA=$GET(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB,0))
- if DDATA=""
- QUIT
- +6 ;Ignore if disabled
- +7 IF $PIECE(DDATA,U,3)=1
- QUIT
- +8 SET DSUB=$PIECE(DDATA,U)
- if DDATA=""
- QUIT
- +9 SET DSEQ=DSEQ+1
- +10 ;Set defaults to null
- +11 SET DDEF=""
- SET DEXC=""
- SET DREQ=""
- SET DSNL=""
- +12 ;Prompt name and GUI process (quit if null)
- +13 SET DNAME=$PIECE($GET(^PXRMD(801.41,DSUB,0)),U)
- SET DGUI=$$GUI(DSUB)
- +14 IF $GET(DGUI)="WH_NOT_PURP"
- Begin DoDot:2
- +15 SET PRINT=$$GET^XPAR($GET(DUZ)_";VA(200,^SRV.`"_+$GET(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
- End DoDot:2
- +16 ;Type Prompt or Forced
- +17 SET DTYP=$PIECE($GET(^PXRMD(801.41,DSUB,0)),U,4)
- +18 IF DTYP="P"
- Begin DoDot:2
- +19 SET DREQ=$PIECE(DDATA,U,2)
- SET DTXT=$PIECE($GET(^PXRMD(801.41,DSUB,2)),U,4)
- +20 ;Override caption/start new line/exclude from PN from finding type
- +21 SET DOVR=$PIECE(DDATA,U,5)
- SET DSNL=$PIECE(DDATA,U,6)
- SET DEXC=$PIECE(DDATA,U,7)
- +22 SET DNAME=DTXT
- IF DOVR]""
- SET DNAME=DOVR
- +23 ;Required/Prompt caption
- +24 SET DDATA=$GET(^PXRMD(801.41,DSUB,2))
- End DoDot:2
- +25 SET ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_U_$GET(PRINT)
- End DoDot:1
- +26 QUIT
- +27 ;
- PTXT(ITEM,NDATA) ;Get progress note (WP) text for type 6 records
- +1 NEW ARRAY,LAST,NULL,SUB,TEXT,TXTCNT
- +2 SET SUB=0
- +3 FOR
- SET SUB=$ORDER(^PXRMD(801.41,ITEM,35,SUB))
- if 'SUB
- QUIT
- Begin DoDot:1
- +4 SET ARRAY(SUB)=$GET(^PXRMD(801.41,ITEM,35,SUB,0))
- End DoDot:1
- +5 SET SUB=0
- SET LAST=0
- FOR
- SET SUB=$ORDER(ARRAY(SUB))
- if 'SUB
- QUIT
- Begin DoDot:1
- +6 SET TEXT=$GET(ARRAY(SUB))
- +7 SET NULL=0
- IF (TEXT="")!($EXTRACT(TEXT)=" ")
- SET NULL=1
- +8 IF LAST
- IF 'NULL
- SET TEXT="<br>"_TEXT
- +9 SET TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
- +10 SET LAST=0
- IF NULL
- SET TEXT="<br>"_TEXT
- SET LAST=1
- +11 SET OCNT=OCNT+1
- SET ORY(OCNT)=6_U_ITEM_U_U_TEXT_U_$GET(NDATA)
- End DoDot:1
- +12 QUIT
- +13 ;
- +14 ;function to determine if the prompt is valid for the taxonomy encounter type.
- TAXPRMPT(DIEN,DTTYP,DCUR) ;
- +1 NEW FIND,IEN
- +2 SET IEN=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,4)
- IF +IEN=0
- QUIT 1
- +3 SET FIND=$PIECE($GET(^PXRMD(801.45,IEN,0)),U)
- IF FIND=""
- QUIT 1
- +4 IF FIND=DTTYP
- QUIT 1
- +5 QUIT 0
- +6 ;