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

PXRMDLLA.m

Go to the documentation of this file.
  1. 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
  1. ; ICR API/FILE
  1. ; 3112 ^GMRD(120.51,
  1. ; 2263 $$GET^XPAR
  1. ;
  1. N DONE,FILE,FIELD,FIND,FINDS,HASVALUE,I,LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
  1. N NODE,NUM,PAT,PKG,OVALUE,PROMPT,PMPTTYPE,RESULT,RTN,SUB,VAL
  1. S NUM=0 F S NUM=$O(^PXRMD(801.41,DITEM,10,NUM)) Q:NUM'>0 D
  1. . S LINK=$G(^PXRMD(801.41,DITEM,10,NUM,"LINK"))
  1. . I LINK=""!(+LINK'>0)!(+$P(LINK,U,2)'=1) Q
  1. . D GETLINK^PXRMDLLB(+LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
  1. . I $P(LINKACT,U)'="" Q
  1. . I LINKTYPE="ELEMENT" Q
  1. . S FIND=$P($G(^PXRMD(801.41,+LINKITEM,1)),U,5)
  1. . I FIND'[801.46 Q
  1. . S NODE=$G(^PXRMD(801.46,+FIND,0))
  1. . S PMPTTYPE=$P($G(^PXRMD(801.46,+FIND,2)),U) I PMPTTYPE'>0 Q
  1. . I $P($G(^PXRMD(801.42,PMPTTYPE,0)),U)'=LINKTYPE Q
  1. . S PKG=$P(NODE,U,2)
  1. . ;S PKG=$$EXTERNAL^DILFD(801.46,2,"",$P(NODE,U,2))
  1. . S FILE=$P(NODE,U,3),FIELD=$P($G(^PXRMD(801.46,+FIND,2)),U,2)
  1. . ;I $D(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD)) Q
  1. . I $G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))'="" Q
  1. . S OVALUE=""
  1. . S RTN=$P($G(^PXRMD(801.47,LINKFUNC,0)),U,2,3) Q:$P(RTN,U)="" Q:$P(RTN,U,2)=""
  1. . S NUM=0 F S NUM=$O(^PXRMD(801.48,+LINK,2,NUM)) Q:NUM'>0 D
  1. . .S NODE=$G(^PXRMD(801.48,+LINK,2,+NUM,0)),SUB=$P(NODE,U),VAL=$P(NODE,U,2) Q:SUB="" Q:VAL=""
  1. . .S INPUTS(SUB)=VAL
  1. . S PAT=0
  1. . S TEMP="S RET=$$"_RTN_"(.RESULT,PAT,VALUE,OVALUE,.INPUTS)"
  1. . X TEMP
  1. . I LINKFUNC>0,RESULT="" Q
  1. . S ^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID)=RESULT
  1. Q
  1. ;
  1. FREC(DFIEN,DFTYP,DITEM,PTDEF,DLGIEN,NDATA) ;Build type 3 record
  1. N CSARRAY,CSCNT
  1. N ARRAY,DATANODE,DCAP,DGUI,DFN,NODE,PRINT,OINAME,STATUS,START,STOP
  1. S PRINT=$S($P($G(^PXRMD(801.41,DLGIEN,"DATA")),U,3)=1:1,1:0)
  1. ;Dialog type/text and resolution
  1. S DNAM=$$NAME(DFIEN,DFTYP)
  1. ;Translate vitals ien to PCE code - This will need a DBIA
  1. S DCOD=""
  1. I DPCE="VIT" D
  1. .S DFIEN=$$GET1^DIQ(120.51,DFIEN,7,"E")
  1. .;Vitals Caption
  1. .S DVIT=$P($G(^PXRMD(801.41,DITEM,2)),U,4)
  1. I DFTYP]"" D
  1. .S OCNT=OCNT+1
  1. .S ORY(OCNT)=3_U_DITEM_U_U_DPCE_U_DEXC_U_DFIEN_U_$G(DCOD)_U_DNAM_U_U_DVIT
  1. .;Get order type for orderable items
  1. .;DBIA #3110
  1. .S:DPCE="Q" $P(ORY(OCNT),U,11)=$P($G(^ORD(101.41,DFIEN,0)),U,4)
  1. .;If mental health check if a GAF score and if MH test is required
  1. .I DPCE="MH",DFIEN D
  1. ..;DBIA #5044
  1. ..I $P($G(^YTT(601.71,DFIEN,0)),U)="GAF" S $P(ORY(OCNT),U,12)=1
  1. ..;Check to see if the MH test is required
  1. ..S $P(ORY(OCNT),U,13)=+$P($G(^PXRMD(801.41,DITEM,0)),U,18)
  1. ..I $P(ORY(OCNT),U,13)=2,$$PATCH^XPDUTL("OR*3.0*243")=0 S $P(ORY(OCNT),U,13)=1
  1. .;
  1. .I DPCE="IMM"!(DPCE="SK") D
  1. ..S DCAP=$P($G(^PXRMD(801.41,DITEM,2)),U,4)
  1. ..;S $P(ORY(OCNT),U,10)=DCAP
  1. ..S $P(ORY(OCNT),U,10)=$$CTRL^XMXUTIL1(DCAP)
  1. ..S $P(ORY(OCNT),U,13)=+$P($G(^PXRMD(801.41,DITEM,"DATA")),U,4)
  1. .S DATANODE=$G(^PXRMD(801.41,DITEM,"DATA"))
  1. .;S $P(ORY(OCNT),U,16)=+$P(DATANODE,U,2)
  1. .S $P(ORY(OCNT),U,16)=+NDATA
  1. .S $P(ORY(OCNT),U,17)=$P(DATANODE,U)
  1. .S $P(ORY(OCNT),U,18)=$S($P(^PXRMD(801.41,DITEM,0),U,16)="IMMREAD":1,1:0)
  1. .;
  1. .I DPCE="GFIND" D
  1. ..N FILE,FIELD,ID,NODE,PKGNAME,VALUE,MULVAL,EXIT
  1. ..;N CID,NDATA,TYPE,VALUE,X
  1. ..N CID,TYPE,VALUE,X
  1. ..S NODE(0)=$G(^PXRMD(801.46,DFIEN,0)),NODE(2)=$G(^(2)),NODE(3)=$G(^(3))
  1. ..S PKG=$P(NODE(0),U,2)
  1. ..;S PKGNAME=$$EXTERNAL^DILFD(801.46,2,"",$P(NODE(0),U,2))
  1. ..S FILE=$P(NODE(0),U,3),MULVAL=$P(NODE(3),U)
  1. ..;S NDATA=+$P(DATANODE,U,2)
  1. ..F X=1,2 D
  1. ...S NODE(X)=$G(^PXRMD(801.46,DFIEN,X))
  1. ...S FIELD=$P(NODE(X),U,2)
  1. ...I X=1 S VALUE=$S('NDATA:$P(NODE(X),U),1:"")
  1. ...I FIELD="" Q
  1. ...I MULVAL="M",'NDATA D
  1. ....S ID="" F S ID=$O(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID)) Q:ID=""!($G(EXIT)) D
  1. .....I $G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))=VALUE S EXIT=ID
  1. ....I $G(EXIT) S ID=EXIT
  1. ...I MULVAL="S",'NDATA S ID=$O(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,""))
  1. ...;Exit Process: If mismatched values on edits
  1. ...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
  1. ...;Exit Process: If new values on edits
  1. ...I $G(ID)="",X=1,VALUE'="" S $P(ORY(OCNT),U,14)=$G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE)) Q
  1. ...;Exit Process: New record
  1. ...I $G(ID)="",VALUE="",X=1 Q
  1. ...I $G(ID)="",X=2 Q
  1. ...;
  1. ...S $P(ORY(OCNT),U,14)=$G(ID)
  1. ...S $P(ORY(OCNT),U,15)=$S($G(ID)'="":$G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID)),1:VALUE)
  1. ...;I $D(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE))=11 S ^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD)=$G(ID)
  1. ...;Set default prompt values to be accessed in PROTH line tag
  1. ...I $P(NODE(2),U)>0,'NDATA,$G(ID)'="" D
  1. ....S DGUI=$P($G(^PXRMD(801.42,$P(NODE(2),U),0)),U)
  1. ....I DGUI="GF_PRINT BUTTON",PRINT=0 Q
  1. ....;S PTDEF(DGUI)=$P(ORY(OCNT),U,15)
  1. ....S PTDEF(DGUI)=$G(^TMP($J,"PXRM GEN FINDING",DLGIEN,PKG,FILE,FIELD,ID))
  1. ...;
  1. ...I $P(ORY(OCNT),U,15)'="",$G(ID)'="" D EXECLINK(DITEM,$P(ORY(OCNT),U,15),ID)
  1. Q
  1. ;
  1. GUI(IEN) ;Work out prompt type for PCE
  1. Q:IEN="" ""
  1. N SUB S SUB=$P($G(^PXRMD(801.41,IEN,46)),U)
  1. Q:'SUB ""
  1. Q $P($G(^PXRMD(801.42,SUB,0)),U)
  1. ;
  1. LOAD(DITEM,DCUR,DTTYP,DLGIEN,NDATA) ;Load dialog questions into array
  1. N DARRAY,DCOD,DEXC,DFIND,DFIEN,DFTYP,DNAM,DPCE,DRES,DSEQ,DSUB,DTYP,OCNT
  1. N DVIT,MAGNODE,NODE,CNT,IDENT,TAXBUILT,TAXNODE,TDX,TPR,TSC,TSEL
  1. N PTDEF
  1. N RFVAL,ISIMM,ISSKT
  1. I +$G(DITEM)'>0 Q
  1. I $E($G(DLGIEN),1)="R" S DLGIEN=$P($G(^PXD(811.9,$P($G(DLGIEN),"R",2),51)),U)
  1. E S DLGIEN=$G(DLGIEN)
  1. S (ISIMM,ISSKT)=0
  1. ;DBIA #3110 OR(101.41
  1. ;
  1. ;Build list of PCE codes
  1. S DARRAY("AUTTEDT(")="PED"
  1. S DARRAY("AUTTEXAM(")="XAM"
  1. S DARRAY("AUTTHF(")="HF"
  1. S DARRAY("AUTTIMM(")="IMM"
  1. S DARRAY("AUTTSK(")="SK"
  1. ;
  1. S DARRAY("GMRD(120.51,")="VIT"
  1. S DARRAY("ORD(101.41,")="Q"
  1. S DARRAY("YTT(601.71,")="MH"
  1. ;
  1. S DARRAY("ICD9(")="POV"
  1. S DARRAY("ICPT(")="CPT"
  1. S DARRAY("WV(790.404,")="WH"
  1. S DARRAY("WV(790.1,")="WHR"
  1. S DARRAY("PXRMD(801.46,")="GFIND"
  1. ;
  1. S DARRAY("PXD(811.2,")="T"
  1. ;
  1. ;Get the dialog element
  1. S OCNT=0
  1. N TERMNODE,TERMSTAT,TERMOUT
  1. S DTYP=$P($G(^PXRMD(801.41,DITEM,0)),U,4)
  1. ;Finding detail
  1. S DRES=$P($G(^PXRMD(801.41,DITEM,1)),U,3)
  1. S DFIND=$P($G(^PXRMD(801.41,DITEM,1)),U,5)
  1. ;check for WH finding
  1. I $P($G(^PXRMD(801.41,DITEM,0)),U,16)["WH" S DFIND=$G(WHFIND) K WHFIND
  1. ;
  1. S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2)
  1. S MAGNODE=""
  1. S DPCE="",DVIT="" I DFTYP'="" S DPCE=$G(DARRAY(DFTYP))
  1. ;Exclude from P/N
  1. S DEXC=$P($G(^PXRMD(801.41,DITEM,2)),U,3)
  1. ;
  1. ;Non taxonomy codes (3 - finding record)
  1. I DPCE="IMM" S ISIMM=1
  1. I DPCE="SK" S ISSKT=1
  1. S MAGNODE=$$GETMAG^PXRMDLG6(DFIEN,DFTYP)
  1. I DPCE'="T" D
  1. .D FREC(DFIEN,DFTYP,DITEM,.PTDEF,DLGIEN,.NDATA)
  1. .;S MAGNODE=$$GETMAG^PXRMDLG6(DFIEN,DFTYP)
  1. ;
  1. ;Taxonomy codes need expanding (3 - finding record)
  1. I DPCE="T" D
  1. .S TAXBUILT=0
  1. .I $G(DTTYP)="" D
  1. ..S TAXNODE=$G(^PXRMD(801.41,DITEM,"TAX"))
  1. ..S TSEL=$P(TAXNODE,U) I TSEL="N" Q
  1. ..S TDX=$$TOK^PXRMDTAX(DFIEN,"POV")
  1. ..S TPR=$$TOK^PXRMDTAX(DFIEN,"CPT")
  1. ..S TSC=$$TOK^PXRMDTAX(DFIEN,"SC")
  1. ..I TSEL="D" S DTTYP="POV",TAXBUILT=1 Q
  1. ..I TSEL="P" S DTTYP="CPT",TAXBUILT=1 Q
  1. ..I TSEL="S" S DTTYP="SC",TAXBUILT=1 Q
  1. ..I TDX,TPR,TSC Q
  1. ..I TDX,'TPR,'TSC S DTTYP="POV",TAXBUILT=1 Q
  1. ..I TPR,'TDX,'TSC S DTTYP="CPT",TAXBUILT=1 Q
  1. ..I TSC,'TDX,'TPR S DTTYP="SC",TAXBUILT=1 Q
  1. .I $G(DTTYP)'="" D EXP^PXRMDLLB(DITEM,DFIEN,DCUR,DTTYP,5,NDATA) I TAXBUILT=0 Q
  1. .D EXPTAX^PXRMDLLB(DITEM,DFIEN,DCUR,NDATA)
  1. ;
  1. ;AGP BEGIN MOVE OF ADD FINDINGS
  1. ;Additional findings
  1. N FASUB
  1. S FASUB=0
  1. F S FASUB=$O(^PXRMD(801.41,DITEM,3,FASUB)) Q:'FASUB D
  1. .;new DPCE here to keep the dialog prompts based off the finding item PCE value
  1. .N DPCE
  1. .S DFIND=$P($G(^PXRMD(801.41,DITEM,3,FASUB,0)),U)
  1. .S DFIEN=$P(DFIND,";"),DFTYP=$P(DFIND,";",2) Q:DFTYP="" Q:DFIEN=""
  1. .S DVIT="",DPCE=$G(DARRAY(DFTYP))
  1. .I DPCE'="",DPCE'="T" D FREC(DFIEN,DFTYP,DITEM,.PTDEF,DLGIEN,NDATA)
  1. .I DPCE'="",DPCE="T" D
  1. ..D EXP^PXRMDLLB(DITEM,DFIEN,DCUR,"CPT",3,NDATA)
  1. ..D EXP^PXRMDLLB(DITEM,DFIEN,DCUR,"POV",3,NDATA)
  1. ..D EXP^PXRMDLLB(DITEM,DFIEN,DCUR,"SC",3,NDATA)
  1. ;;AGP END MOVE OF ADD FINDINGS
  1. ;
  1. ;Prompt details (4 - prompt records)
  1. N ARRAY,DTITLE,DREQ,DSEQ,DSSEQ,DSUB,DTYP
  1. ;If not a taxonomy get prompts from dialog file
  1. ;I DPCE'="T",'HASVIMM D PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE)
  1. I DPCE'="T",'ISSKT D PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE,ISIMM)
  1. ;Check for MST findings
  1. I (DPCE'="T"),(DFTYP]"") D MST^PXRMDLLB(DFTYP,DFIEN)
  1. ;If taxonomy use finding parameters (CPT/POV)
  1. I DPCE="T" D
  1. .I $G(DTTYP)="",$G(^PXRMD(801.41,DITEM,"TAX"))'="N" Q
  1. .I MAGNODE'="" D Q
  1. ..I $G(DTTYP)'="",$G(DCUR)'="" D PROTH(DITEM,DTTYP,DCUR,.PTDEF,DLGIEN,MAGNODE,0) Q
  1. ..D PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE,0)
  1. .I $D(^PXRMD(801.41,DITEM,10,"B"))>0 D Q
  1. ..I $G(DTTYP)'="",$G(DCUR)'="" D PROTH(DITEM,DTTYP,DCUR,.PTDEF,DLGIEN,MAGNODE,0) Q
  1. ..D PROTH(DITEM,"","",.PTDEF,DLGIEN,MAGNODE,0)
  1. ;Return array of type 4 records
  1. S DSEQ=""
  1. F S DSEQ=$O(ARRAY(DSEQ)) Q:'DSEQ D
  1. .S OCNT=OCNT+1
  1. .S ORY(OCNT)=4_U_DITEM_U_DSEQ_U_ARRAY(DSEQ)
  1. .S DSSEQ=""
  1. .S $P(ORY(OCNT),U,20)=$G(NDATA)
  1. .F S DSSEQ=$O(ARRAY(DSEQ,DSSEQ)) Q:'DSSEQ D
  1. ..S OCNT=OCNT+1
  1. ..S ORY(OCNT)=4_U_DITEM_U_DSEQ_"."_DSSEQ_U_ARRAY(DSEQ,DSSEQ)
  1. ..S $P(ORY(OCNT),U,20)=$G(NDATA)
  1. ;
  1. ;Get progress note text if defined
  1. ;Build Alternate progress note text for taxonomies with more then one pick list.
  1. I DTTYP="" D:'DEXC PTXT(DITEM,.NDATA)
  1. ;Build Alternate progress note text for taxonomies with one pick list.
  1. I DPCE="T",DTTYP'="" D:'DEXC PTXT(DITEM,.NDATA)
  1. Q
  1. ;
  1. ;Returns item name
  1. NAME(DFIEN,DFTYP) ;
  1. Q:DFTYP="" ""
  1. Q:DFIEN="" ""
  1. N NAME,FGLOB,POSN
  1. ;DBIA #4108
  1. I DFTYP="WV(790.404," S NAME=$P($G(^WV(790.404,DFIEN,0)),U) Q:NAME]"" NAME
  1. I DFTYP="WV(790.1," S NAME=$G(WHNAME) K WHNAME Q:NAME]"" NAME
  1. I DFTYP="PXRMD(801.46," S NAME=$P($G(^PXRMD(801.46,DFIEN,0)),U) Q:NAME]"" NAME
  1. S POSN=2
  1. S:DFTYP["AUTT" POSN=1 S:DFTYP["AUTTEDT" POSN=4 S:DFTYP["ICD" POSN=3
  1. S FGLOB=U_DFTYP_DFIEN_",0)",NAME=$P($G(@FGLOB),U,POSN)
  1. I (POSN>1),NAME="" S NAME=$P($G(@FGLOB),U)
  1. I NAME="" S NAME=DFIEN
  1. Q NAME
  1. ;
  1. PROTH(IEN,DTTYP,DCUR,PTDEF,DLGIEN,MAGNODE,ISIMM) ; Additional prompts defined in 801.41
  1. N CANSHOW,DDATA,DDEF,DIEN,DEXC,DGUI,DNAME,DOVR,DREQ,DSEQ,DSNL,DSUB,DFTEXT
  1. N DTXT,DTYP,EVENT,NODE,PRINT,PRINTTYP,SRV,TAX,DVALID
  1. N LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
  1. I MAGNODE'="" D
  1. .S DSEQ=$O(^PXRMD(801.41,IEN,10,"B",""),-1)+1
  1. .S ARRAY(DSEQ)="UCUM"_U_0_U_""_U_"P"_U_$P(MAGNODE,U,5)_U_1_U_1
  1. .S $P(ARRAY(DSEQ),U,27)=MAGNODE
  1. S NODE=$G(^PXRMD(801.41,DLGIEN,"DATA"))
  1. S CANSHOW=$S($P(NODE,U,3)="D":0,$P(NODE,U,3)="":0,1:1)
  1. S PRINTTYP=$P(NODE,U,3)
  1. I CANSHOW=0!(PRINTTYP="S") S PRINTTYP="N"
  1. ;
  1. S DSEQ=0
  1. F S DSEQ=$O(^PXRMD(801.41,IEN,10,"B",DSEQ)) Q:'DSEQ D
  1. .;Get prompts in sequence
  1. .S DSUB=$O(^PXRMD(801.41,IEN,10,"B",DSEQ,"")) Q:'DSUB
  1. .S NODE=$G(^PXRMD(801.41,IEN,10,DSUB,0))
  1. .S EVENT=$S($P(NODE,U,14)'="":$P(NODE,U,14),1:"C")
  1. .;Quit is prompt is marked disable
  1. .I $P(NODE,U,13)=1 Q
  1. .K LINK,LINKITEM,LINKTYPE,LINKFUNC,LINKACT
  1. .S LINK=$G(^PXRMD(801.41,IEN,10,DSUB,"LINK")) I +LINK>0 D GETLINK^PXRMDLLB(+LINK,.LINKITEM,.LINKTYPE,.LINKFUNC,.LINKACT)
  1. .;Prompt ien
  1. .S DIEN=$P($G(^PXRMD(801.41,IEN,10,DSUB,0)),U,2) Q:'DIEN
  1. .;Ignore disabled components, and those that are not prompts
  1. .I $$ISDISAB^PXRMDLL(DIEN)=1 Q
  1. .Q:"PF"'[$P($G(^PXRMD(801.41,DIEN,0)),U,4)
  1. .;I ISIMM,$P($G(^PXRMD(801.41,DIEN,0)),U,4)'="F" Q
  1. .;check to make sure prompt is apporiate for the taxonomy encounter type
  1. .I $G(DTTYP)'="",$G(DCUR)'="",$$TAXPRMPT(DIEN,DTTYP,DCUR)=0 Q
  1. .;Set defaults to null
  1. .S DDEF="",DEXC="",DREQ="",DSNL=""
  1. .;Prompt name and GUI process (quit if null)
  1. .S DNAME=$P($G(^PXRMD(801.41,DIEN,0)),U),DGUI=$$GUI(DIEN)
  1. .;I ISIMM,$P($G(^PXRMD(801.41,DIEN,0)),U,4)'="F" Q
  1. .I ISIMM,DGUI'="IMM_SER" Q
  1. .I DGUI="GF_PRINT",CANSHOW=0 Q
  1. .I $G(DGUI)="WH_NOT_PURP" D
  1. ..S SRV=$$GET1^DIQ(200,DUZ,29,"I")
  1. ..S PRINTTYP=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
  1. .;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")
  1. .I DGUI="GF_VIEW" S PRINTTYP="N"
  1. .;Type Prompt or Forced
  1. .S DTYP=$P($G(^PXRMD(801.41,DIEN,0)),U,4)
  1. .I "PF"[DTYP D
  1. ..;Required/Prompt caption
  1. ..S DDATA=$G(^PXRMD(801.41,DIEN,2)),DTXT=$P(DDATA,U,4)
  1. ..;Default value or forced value
  1. ..S:DTYP="P" DDEF=$P(DDATA,U) S:DTYP="F" DDEF=$P(DDATA,U,2)
  1. ..I ISIMM,DGUI="IMM_SER",DTYP="P" S DTYP="F"
  1. ..;Override caption/start new line/exclude PN from dialog file
  1. ..S DDATA=$G(^PXRMD(801.41,IEN,10,DSUB,0)),DREQ=$P(DDATA,U,9)
  1. ..S DOVR=$P(DDATA,U,6),DSNL=$P(DDATA,U,7),DEXC=$P(DDATA,U,8)
  1. ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
  1. ..;Convert date to fileman format
  1. ..I DGUI="VST_DATE",DDEF["T" S DDEF=$$DT^XLFDT()
  1. .I $G(DGUI)'="",$G(PTDEF(DGUI))'="" S DDEF=PTDEF(DGUI)
  1. .;I $G(RFVAL)'="" S DDEF=RFVAL K RFVAL
  1. .I DGUI="DATE" S DVALID=$P(NODE,U,11)
  1. .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)
  1. .S $P(ARRAY(DSEQ),U,25)=$P($G(LINKACT),U,2)
  1. .S $P(ARRAY(DSEQ),U,26)=EVENT
  1. .;
  1. .I DGUI="UCUM",MAGNODE'="" S $P(ARRAY(DSEQ),U,27)=$P(MAGNODE,U,1,4)_U_$P(MAGNODE,U,6)
  1. .;the following section add a comment prompt to the WH review of result
  1. .;section of the reminder dialog
  1. .I DGUI="WH_PAP_RESULT",DFTYP="WV(790.1,",DTYP="P" D
  1. ..N WHCNT,WHFLAG,WHNUM,WHLOOP
  1. ..S WHNUM=DSEQ+1,WHLOOP=0
  1. ..F WHLOOP=0 D
  1. ...S (WHCNT,WHFLAG)=0
  1. ...F S WHCNT=$O(^PXRMD(801.41,IEN,10,"B",WHCNT)) Q:'WHCNT!(WHFLAG=1) D
  1. ....I WHCNT=WHNUM S WHFLAG=1,WHNUM=WHNUM+1
  1. ...I WHFLAG=0 S WHLOOP=1
  1. ..S ARRAY(WHNUM)="COM"_U_U_U_"P"_U_"Comment:"_U_U_U
  1. .;Additional checkboxes
  1. .I DGUI="COM",DIEN>1 D
  1. ..N DSSEQ,DSUB,DTEXT
  1. ..S DSSEQ=0
  1. ..F S DSSEQ=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ)) Q:'DSSEQ D
  1. ...S DSUB=$O(^PXRMD(801.41,DIEN,45,"B",DSSEQ,"")) Q:'DSUB
  1. ...S DTEXT=$P($G(^PXRMD(801.41,DIEN,45,DSUB,0)),U,2) Q:DTEXT=""
  1. ...S ARRAY(DSEQ,DSSEQ)=U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
  1. Q
  1. ;
  1. PRTAX(FNODE,RSUB) ;Get all additional fields for this resolution type
  1. N ACNT,ASUB
  1. N DDATA,DDEF,DEXC,DGUI,DNAME,DREQ,DSEQ,DSUB,DTYP,PRINT
  1. S ASUB=0,DSEQ=0
  1. F S ASUB=$O(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB)) Q:'ASUB D
  1. .S DDATA=$G(^PXRMD(801.45,FNODE,1,RSUB,5,ASUB,0)) Q:DDATA=""
  1. .;Ignore if disabled
  1. .I $P(DDATA,U,3)=1 Q
  1. .S DSUB=$P(DDATA,U) Q:DDATA=""
  1. .S DSEQ=DSEQ+1
  1. .;Set defaults to null
  1. .S DDEF="",DEXC="",DREQ="",DSNL=""
  1. .;Prompt name and GUI process (quit if null)
  1. .S DNAME=$P($G(^PXRMD(801.41,DSUB,0)),U),DGUI=$$GUI(DSUB)
  1. .I $G(DGUI)="WH_NOT_PURP" D
  1. ..S PRINT=$$GET^XPAR($G(DUZ)_";VA(200,^SRV.`"_+$G(SRV)_"^DIV^SYS","PXRM WH PRINT NOW",1,"I")
  1. .;Type Prompt or Forced
  1. .S DTYP=$P($G(^PXRMD(801.41,DSUB,0)),U,4)
  1. .I DTYP="P" D
  1. ..S DREQ=$P(DDATA,U,2),DTXT=$P($G(^PXRMD(801.41,DSUB,2)),U,4)
  1. ..;Override caption/start new line/exclude from PN from finding type
  1. ..S DOVR=$P(DDATA,U,5),DSNL=$P(DDATA,U,6),DEXC=$P(DDATA,U,7)
  1. ..S DNAME=DTXT I DOVR]"" S DNAME=DOVR
  1. ..;Required/Prompt caption
  1. ..S DDATA=$G(^PXRMD(801.41,DSUB,2))
  1. .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DNAME_U_DSNL_U_DREQ_U_U_$G(PRINT)
  1. Q
  1. ;
  1. PTXT(ITEM,NDATA) ;Get progress note (WP) text for type 6 records
  1. N ARRAY,LAST,NULL,SUB,TEXT,TXTCNT
  1. S SUB=0
  1. F S SUB=$O(^PXRMD(801.41,ITEM,35,SUB)) Q:'SUB D
  1. .S ARRAY(SUB)=$G(^PXRMD(801.41,ITEM,35,SUB,0))
  1. S SUB=0,LAST=0 F S SUB=$O(ARRAY(SUB)) Q:'SUB D
  1. .S TEXT=$G(ARRAY(SUB))
  1. .S NULL=0 I (TEXT="")!($E(TEXT)=" ") S NULL=1
  1. .I LAST,'NULL S TEXT="<br>"_TEXT
  1. .S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
  1. .S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
  1. .S OCNT=OCNT+1,ORY(OCNT)=6_U_ITEM_U_U_TEXT_U_$G(NDATA)
  1. Q
  1. ;
  1. ;function to determine if the prompt is valid for the taxonomy encounter type.
  1. TAXPRMPT(DIEN,DTTYP,DCUR) ;
  1. N FIND,IEN
  1. S IEN=$P($G(^PXRMD(801.41,DIEN,1)),U,4) I +IEN=0 Q 1
  1. S FIND=$P($G(^PXRMD(801.45,IEN,0)),U) I FIND="" Q 1
  1. I FIND=DTTYP Q 1
  1. Q 0
  1. ;