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

PXRMDLLB.m

Go to the documentation of this file.
  1. PXRMDLLB ;SLC/PJH - REMINDER DIALOG LOADER ;Jan 12, 2023@19:11
  1. ;;2.0;CLINICAL REMINDERS;**6,12,16,26,47,45,65,84**;Feb 04, 2005;Build 2
  1. ;
  1. ; Reference to RESULTS^WVALERTS in ICR #4102
  1. CODES(TXIEN,DTYPE,CODESYS,ARRAY) ;
  1. N CNT,CODE,DATES,END,IEN,NODE,START,TEXT,TYPE
  1. S CNT=0
  1. S TYPE="" F S TYPE=$O(CODESYS(TYPE)) Q:TYPE="" D
  1. .S CODE="" F S CODE=$O(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE)) Q:CODE="" D
  1. ..S START="" F S START=$O(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START)) Q:START="" D
  1. ...S END="" F S END=$O(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START,END)) Q:END="" D
  1. ....S NODE=$G(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START,END)) I NODE="" Q
  1. ....S IEN=$S(DTYPE="SC":CODE,1:$P(NODE,U)),TEXT=$P(NODE,U,2)
  1. ....S DATES=START_":"_$S(END>0:END,1:"")
  1. ....S CNT=CNT+1,ARRAY(CNT)=IEN_U_$G(CODE)_":"_$G(DATES)_U_$G(TEXT)_U_U_TYPE
  1. Q
  1. ;
  1. EXPTAX(DITEM,TIEN,DCUR,NDATA) ;
  1. ;this function handles taxonomy that are set to not display.
  1. N CAT,DTTYP,FIND,FILE,NODE,TSEL
  1. S NODE=$G(^PXRMD(801.41,DITEM,"TAX"))
  1. S TSEL=$P(NODE,U)
  1. I "ND"[TSEL D
  1. .D EXP(DITEM,TIEN,DCUR,"CPT",3,NDATA)
  1. .D EXP(DITEM,TIEN,DCUR,"SC",3,NDATA)
  1. I "NP"[TSEL D
  1. .D EXP(DITEM,TIEN,DCUR,"POV",3,NDATA)
  1. .D EXP(DITEM,TIEN,DCUR,"SC",3,NDATA)
  1. I "NS"[TSEL D
  1. .D EXP(DITEM,TIEN,DCUR,"CPT",3,NDATA)
  1. .D EXP(DITEM,TIEN,DCUR,"POV",3,NDATA)
  1. Q
  1. ;
  1. EXP(DITEM,TIEN,DCUR,DTTYP,TYPE,NDATA) ;Expand taxonomy codes
  1. N CAT,CODES,CODETYPE,CNT,DATANODE,ENC,FILE,LIT,OLDMAG
  1. I DTTYP="" Q
  1. S LIT="Selectable "_$S(DTTYP="POV":"Diagnoses:",DTTYP="SC":"Standard Codes:",1:"Procedures:")
  1. S CAT=$P($G(^PXD(811.2,TIEN,0)),U)
  1. ;
  1. S DATANODE=$G(^PXRMD(801.41,DITEM,"DATA"))
  1. D BLDCODE^PXRMDTAX(DTTYP,.CODETYPE)
  1. S OCNT=OCNT+1
  1. I TYPE=5 D
  1. .S ORY(OCNT)=3_U_DITEM_U_U_DTTYP_U_1_U_TIEN_U_U_U_CAT_U_LIT
  1. .S $P(ORY(OCNT),U,16)=+NDATA
  1. .S $P(ORY(OCNT),U,17)=$P(DATANODE,U)
  1. ;
  1. ;Get selectable codes
  1. D CODES(TIEN,DTTYP,.CODETYPE,.CODES)
  1. S CNT=0
  1. ;Save selectable codes as type 5 or 3 records
  1. F S CNT=$O(CODES(CNT)) Q:'CNT D
  1. .S OCNT=OCNT+1,ORY(OCNT)=TYPE_U_DITEM_U_U_DTTYP_U_U_CODES(CNT)
  1. .S $P(ORY(OCNT),U,16)=+NDATA
  1. .S $P(ORY(OCNT),U,17)=$P(DATANODE,U)
  1. Q
  1. ;
  1. N NODE,RESULT
  1. S NODE=$G(^PXRMD(801.48,LINK,0)) Q:$P(NODE,U,5)=""
  1. S ITEM=$P(NODE,U,2),TYPE=$P(NODE,U,3),FUNC=$P(NODE,U,4)
  1. I TYPE="" S TYPE="ELEMENT"
  1. I TYPE>0 S TYPE=$P($G(^PXRMD(801.42,TYPE,0)),U)
  1. S ACT=$P(NODE,U,5)
  1. S ACT=$S(ACT="C":"CHECKED",ACT="S":"SUPPRESS",ACT="R":"REQUIRED",ACT="V":$G(RESULT),ACT="UC":"UNCHECKED",ACT="US":"UNSUPPRESS",ACT="D":"DISABLE",ACT="E":"UNDISABLE",1:"")
  1. S $P(ACT,U,2)=$S(+$O(^PXRMD(801.48,LINK,3,0))>0:LINK,1:0)
  1. Q
  1. GETLSEQ(RETURN,LINK) ;Return SEQUENCES AFFECTED BY LINK field value
  1. S RETURN(0)=0
  1. I '$D(^PXRMD(801.48,+$G(LINK),0)) Q
  1. N SUB,NODE
  1. S NODE=1
  1. S SUB=0 F S SUB=$O(^PXRMD(801.48,LINK,3,SUB)) Q:SUB'>0 D
  1. .S RETURN(NODE)=$P($G(^PXRMD(801.48,LINK,3,SUB,0)),U)_"~",NODE=NODE+1
  1. .S RETURN(NODE)=$P($G(^PXRMD(801.48,LINK,3,SUB,1)),U),NODE=NODE+1
  1. .S RETURN(NODE)=$P($G(^PXRMD(801.48,LINK,3,SUB,2)),U),NODE=NODE+1
  1. S RETURN(0)=NODE-1
  1. Q
  1. ;
  1. MST(DFTYP,DFIEN) ;Pass MST code as a forced value
  1. ;Validate finding ien
  1. Q:DFIEN=""
  1. ;For each MST term check if finding is mapped
  1. N FOUND,TCOND,TIEN,TNAM,TSUB
  1. S FOUND=0
  1. F TNAM="POSITIVE","NEGATIVE","DECLINES" D Q:FOUND
  1. .;Get term IEN
  1. .S TIEN=$O(^PXRMD(811.5,"B","MST "_TNAM_" REPORT","")) Q:'TIEN
  1. .;Check if finding is mapped to term
  1. .Q:'$D(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN))
  1. .;If exam and term condition logic is null ignore
  1. .I DFTYP="AUTTEXAM(" D Q:TCOND=""
  1. ..S TCOND="",TSUB=$O(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN,"")) Q:'TSUB
  1. ..S TCOND=$P($G(^PXRMD(811.5,TIEN,20,TSUB,3)),U)
  1. .;If it is then create additional prompt for MST
  1. .N DSEQ,DEXC,DDEF,DGUI,DTYP,DTEXT,DSNL,DREQ
  1. .;Add to end of array
  1. .S DSEQ=$O(ARRAY(""),-1)+1
  1. .;Null fields
  1. .S DDEF="",DEXC="",DTEXT="",DSNL="",DREQ=""
  1. .;MST status (exept for exams)
  1. .I DFTYP'="AUTTEXAM(" S DDEF=$$STCODE^PXRMMST("MST "_TNAM_" REPORT")
  1. .;GUI process and forced value
  1. .S DGUI="MST",DTYP="F"
  1. .;Save in array
  1. .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
  1. .;Quit after the first term is found
  1. .S FOUND=1
  1. Q
  1. ;
  1. NREPLACE(DFN,DITEM,DATA,FAIL,BLTXT) ;
  1. N ACTION,BLEVTXT,CDFIEVAL,FACTION,FIEVAL,FNODE,DITEMO,FOUND,IEN,ITEM,NODE,REPLACE,RESULT,SEQ,STATUS,TEMP
  1. S FACTION="",FNODE="",REPLACE=0,BLEVTXT=0,RESULT=0
  1. S FOUND=0,SEQ=0 F S SEQ=$O(^PXRMD(801.41,DITEM,"BL","B",SEQ)) Q:SEQ'>0!(FOUND=1)!(FAIL=1) D
  1. .S RESULT=0
  1. .S IEN=$O(^PXRMD(801.41,DITEM,"BL","B",SEQ,"")) Q:IEN'>0
  1. .S NODE=$G(^PXRMD(801.41,DITEM,"BL",IEN,0))
  1. .S ITEM=$P(NODE,U,2),STATUS=$P(NODE,U,3),ACTION=$P(NODE,U,4)
  1. .I ITEM["811.9" D
  1. ..K CDFIEVAL,FIEVAL
  1. ..S TEMP=$$REMEVAL(+ITEM,DFN,$G(DITEM),STATUS,"D",.FIEVAL,.CDFIEVAL)
  1. ..I TEMP=-1 S FAIL=1 D SENDMSG^PXRMORCH(DFN,"dialog",$P($G(^PXRMD(801.41,DIALOGIEN,0)),U),"definition",+ITEM) Q
  1. ..S RESULT=$$STATMTCH^PXRMORCH(TEMP,STATUS)
  1. ..I $D(CDFIEVAL) K FIEVAL M FIEVAL=CDFIEVAL
  1. .I ITEM["811.5" D
  1. ..S TEMP=$$TERM(+ITEM,DFN,$G(DITEM),"D",.FIEVAL)
  1. ..I TEMP=-1 S FAIL=1 D SENDMSG^PXRMORCH(DFN,"dialog",$P($G(^PXRMD(801.41,DIALOGIEN,0)),U),"term",+ITEM) Q
  1. ..I TEMP=0,STATUS="F" S RESULT=1
  1. ..I TEMP=1,STATUS="T" S RESULT=1
  1. .I FAIL=1 Q
  1. .I RESULT=1 S FOUND=1,FACTION=ACTION,FNODE=NODE,BLEVTXT=+$P(NODE,U,6)
  1. .I RESULT=0,+$P(NODE,U,6)=2 S BLEVTXT=2
  1. Q:FAIL=1
  1. I FOUND=1 D
  1. .I FACTION="H" K DITEM,DATA Q
  1. .I FACTION="C" S $P(DATA,U,11)="C" Q
  1. .I FACTION="S" S $P(DATA,U,11)=1,$P(DATA,U,10)=0 Q
  1. .I FACTION="0"!(+FACTION>0) S $P(DATA,U,9)=FACTION Q
  1. .S DITEM=$P(FNODE,U,5),DATA=$G(^PXRMD(801.41,DITEM,0)) S REPLACE=1
  1. .I $G(DATA)=""!($$ISDISAB^PXRMDLL(DITEM)=1) S DITEM=$O(^PXRMD(801.41,"B","VA-DISABLE BRANCHING LOGIC REPLACEMENT ELEMENT","")),REPLACE=0
  1. I $G(DITEM)>0,$P($G(^PXRMD(801.41,DITEM,0)),U,16)["CRGF" D FIEVAL(DITEM,.FIEVAL,BLEVTXT,.BLTXT)
  1. I RESULT=1,REPLACE=1,$P($G(^PXRMD(801.41,DITEM,0)),U,16)["WHR" D WH(.FIEVAL)
  1. I REPLACE=1,$D(^PXRMD(801.41,DITEM,"BL")) D NREPLACE(DFN,.DITEM,.DATA,.FAIL)
  1. Q
  1. ;
  1. FIEVAL(IEN,FIEVAL,BLEVTXT,BLTXT) ;
  1. N CSUB,CSUBS,ERR,FIELD,FILE,FINDINGS,IDX,NODE,NUM,PKG,PKGNAME,PKGPFIX,SUB,TYPE,X,Y
  1. S SUB=+$O(BLTXT("?"),-1)
  1. ;Need to find term marked for dialog.
  1. S NUM=0 F S NUM=$O(FIEVAL(NUM)) Q:NUM'>0 D
  1. .Q:'$D(FIEVAL(NUM,1))
  1. .;make sure fieval is available for dialog use
  1. .I +$G(FIEVAL(NUM,1,"DIALOG"))'=1 Q
  1. .;set dialog text to build automatically
  1. .I BLEVTXT>0 D ;Q:BLEVTXT=2
  1. ..I $G(FIEVAL(NUM,1,"TEXT"))'="" S SUB=SUB+1,BLTXT(SUB)=FIEVAL(NUM,1,"TEXT")
  1. ..I $D(FIEVAL(NUM,1,"TEXT"))>1 D
  1. ...S X=0 F S X=$O(FIEVAL(NUM,1,"TEXT",X)) Q:X'>0 S SUB=SUB+1,BLTXT(SUB)=FIEVAL(NUM,1,"TEXT",X)
  1. .;check to see if finding match the package in term evaluation
  1. .S PKGNAME=$G(FIEVAL(NUM,1,"PACKAGE")) Q:PKGNAME=""
  1. .S PKGPFIX=$G(FIEVAL(NUM,1,"PACKAGE PREFIX")) Q:PKGPFIX=""
  1. .S PKG=$$FIND1^DIC(9.4,"",,PKGNAME,,"I $P(^(0),U,2)="""_PKGPFIX_"""","ERR") I PKG'>0 Q
  1. .I '$D(^PXRMD(801.46,"P",PKG)) Q
  1. .;retrieve general findings from current dialog
  1. .D:'$D(FINDINGS) FINDGFIN(IEN,PKG,.FINDINGS)
  1. .;Find record ID for this FIEVAL
  1. .N DAS
  1. .S CSUB="" F S CSUB=$O(FINDINGS("PXRM CID INDEX",CSUB)) Q:CSUB=""!($G(DAS)'="") D
  1. ..I '$D(FIEVAL(NUM,1,CSUB)) Q
  1. ..S DAS=FIEVAL(NUM,1,CSUB),DAS("FILE")=$P(FINDINGS(CSUB),U)
  1. .Q:$G(DAS)=""
  1. .S CSUB="" F S CSUB=$O(FINDINGS(CSUB)) Q:CSUB="" D
  1. ..I '$D(FIEVAL(NUM,1,CSUB)) Q
  1. ..Q:$D(CSUBS(CSUB))
  1. ..S NODE=FINDINGS(CSUB)
  1. ..S FILE=$P(NODE,U),TYPE=$P(NODE,U,3),PKG=$P(NODE,U,5)
  1. ..I FILE<=0!(TYPE="")!(PKG="") Q
  1. ..S FIELD=$P(NODE,U,2) I FIELD="" Q
  1. ..I $G(^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE))="",FILE=DAS("FILE") S ^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE)=DAS
  1. ..I TYPE="S",$G(FIEVAL(NUM,1,CSUB))'="" S ^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,DAS)=FIEVAL(NUM,1,CSUB)
  1. ..I TYPE="M" D
  1. ...S IDX=0 F S IDX=$O(FIEVAL(NUM,1,CSUB,IDX)) Q:'IDX D
  1. ....S ^TMP($J,"PXRM GEN FINDING",DIALOGIEN,PKG,FILE,FIELD,IDX_","_DAS)=$G(FIEVAL(NUM,1,CSUB,IDX))
  1. ..S CSUBS(CSUB)=""
  1. Q
  1. ;
  1. REMEVAL(RIEN,DFN,IEN,STATUS,TYPE,FIEVAL,CDFIEVAL) ;
  1. N DEFARR,NODE,RNAME,PXRMDEFS,RSTAT
  1. K ^TMP("PXRHM",$J)
  1. I $D(^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN)) D Q RSTAT
  1. .M FIEVAL=^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN,"FIEVAL")
  1. .I $D(^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN,"CDFIEVAL")) K FIEVAL M FIEVAL=^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN,"CDFIEVAL")
  1. .S RSTAT=^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN,"STATUS")
  1. S NODE=$G(^PXD(811.9,RIEN,0))
  1. S RNAME=$S($P(NODE,U,3)'="":$P(NODE,U,3),1:$P(NODE,U))
  1. D DEF^PXRMLDR(RIEN,.DEFARR)
  1. D EVAL^PXRM(DFN,.DEFARR,5,1,.FIEVAL,DT)
  1. S RSTAT=$P($G(^TMP("PXRHM",$J,RIEN,RNAME)),U)
  1. K ^TMP("PXRHM",$J)
  1. I RSTAT="ERROR" Q -1
  1. M ^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN,"FIEVAL")=FIEVAL
  1. S ^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN,"STATUS")=RSTAT
  1. I $P($G(^PXRMD(801.41,IEN,0)),U,16)'["CRGF" Q RSTAT
  1. I $D(^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN,"CDFIEVAL")) M CDFIEVAL=^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN,"CDFIEVAL") Q
  1. M CDFIEVAL=^TMP("PXRM BL DATA",$J,"FIEVAL") K ^TMP("PXRM BL DATA",$J)
  1. M ^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"REMINDER",RIEN,"CDFIEVAL")=CDFIEVAL
  1. Q RSTAT
  1. ;
  1. RESGROUP(DIEN) ;
  1. N CNT,RESULT,TEMP
  1. S RESULT=""
  1. I $$PATCH^XPDUTL("OR*3.0*243")=0 D Q RESULT
  1. .S RESULT=$P($G(^PXRMD(801.41,DIEN,51,1,0)),U) I RESULT="" Q
  1. .I $$ISDISAB^PXRMDLL(RESULT)=1 S RESULT="" Q
  1. S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,51,CNT)) Q:CNT'>0 D
  1. .S TEMP=$P($G(^PXRMD(801.41,DIEN,51,CNT,0)),U) I TEMP="" Q
  1. .I $$ISDISAB^PXRMDLL(TEMP)=1 S TEMP="" Q
  1. .S RESULT=$S(RESULT="":TEMP,1:RESULT_"~"_TEMP)
  1. Q RESULT
  1. ;
  1. TERM(TERMIEN,DFN,IEN,TYPE,FIEVAL) ;
  1. ;this section is use to for the term evaluation
  1. N CDFIEVAL,RESULT,TFAIL
  1. S TFAIL=0
  1. D TERMEVAL(DFN,IEN,$G(DIALOGIEN),TERMIEN,.FIEVAL,.CDFIEVAL,.TFAIL)
  1. I TFAIL=1 Q -1
  1. S RESULT=$G(FIEVAL(1))
  1. I $D(CDFIEVAL)>0 K FIEVAL M FIEVAL=CDFIEVAL
  1. Q RESULT
  1. ;
  1. TERMEVAL(DFN,IEN,DIALOGIEN,TERMIEN,FIEVAL,CDFIEVAL,TFAIL) ;
  1. N CLEAN,FINDPA,PXRMITEM,PXRMPID,TERMARR
  1. S TERMARR="",PXRMITEM=TERMIEN,PXRMPID="PXRMTERM"_PXRMITEM_$H,CLEAN=0
  1. K FIEVAL,CDFIEVAL
  1. ;order checks only
  1. I +DIALOGIEN=0 D Q
  1. .D TERM^PXRMLDR(TERMIEN,.TERMARR)
  1. .;term evaulation
  1. .S FINDPA(0)=""
  1. .D IEVALTER^PXRMTERM(DFN,.FINDPA,.TERMARR,1,.FIEVAL)
  1. .I $D(^TMP(PXRMPID,$J,TERMIEN)) S TFAIL=1
  1. ;dialog branching logic process
  1. ;if Cache exist used results
  1. I $D(^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"TERM",TERMIEN)) D Q
  1. .M FIEVAL=^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"TERM",TERMIEN,"FIEVAL")
  1. .M CDFIEVAL=^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"TERM",TERMIEN,"CDFIEVAL")
  1. ;build term array
  1. D TERM^PXRMLDR(TERMIEN,.TERMARR)
  1. I '$D(PXRMSRCFF) S PXRMSRCFF=1,CLEAN=1
  1. ;term evaluation
  1. S FINDPA(0)=""
  1. D IEVALTER^PXRMTERM(DFN,.FINDPA,.TERMARR,1,.FIEVAL)
  1. I $D(^TMP(PXRMPID,$J,TERMIEN)) S TFAIL=1 Q
  1. M ^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"TERM",TERMIEN,"FIEVAL")=FIEVAL
  1. I $P($G(^PXRMD(801.41,IEN,0)),U,16)'["CRGF" Q
  1. I $D(^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"TERM",TERMIEN,"CDFIEVAL")) M CDFIEVAL=^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"TERM",TERMIEN,"CDFIEVAL") Q
  1. M CDFIEVAL=^TMP("PXRM BL DATA",$J,"FIEVAL") I CLEAN K ^TMP("PXRM BL DATA",$J),PXRMSRCFF
  1. M ^TMP($J,"PXRM DIALOG EVAL",DIALOGIEN,"TERM",TERMIEN,"CDFIEVAL")=CDFIEVAL
  1. Q
  1. ;
  1. FINDGFIN(IEN,PKG,FINDINGS) ; Return list of GENERAL FINDINGS in dialog
  1. I IEN'>0 Q
  1. N CIEN,FINDING,AFIEN
  1. S CIEN=0 F S CIEN=$O(^PXRMD(801.41,IEN,10,CIEN)) Q:'+CIEN D
  1. .I $P(^PXRMD(801.41,IEN,10,CIEN,0),U,2)'="" D FINDGFIN($P(^PXRMD(801.41,IEN,10,CIEN,0),U,2),PKG,.FINDINGS)
  1. S FINDING=$P($G(^PXRMD(801.41,IEN,1)),U,5)
  1. I FINDING[";PXRMD(801.46,",$D(^PXRMD(801.46,+FINDING))>9 D
  1. .D FINDDATA(+FINDING,PKG,.FINDINGS)
  1. S AFIEN=0 F S AFIEN=$O(^PXRMD(801.41,IEN,3,AFIEN)) Q:'+AFIEN D
  1. .S FINDING=$P($G(^PXRMD(801.41,IEN,3,AFIEN,0)),U)
  1. .I FINDING[";PXRMD(801.46,",$D(^PXRMD(801.46,+FINDING))>9 D
  1. ..D FINDDATA(+FINDING,PKG,.FINDINGS)
  1. Q
  1. ;
  1. FINDDATA(FIND,PKG,FINDINGS) ;
  1. N FILE,FIELD,NDATA,NODE,CID,SUB,TYPE,X
  1. S FILE=$P($G(^PXRMD(801.46,FIND,0)),U,3) I FILE="" Q
  1. I $P($G(^PXRMD(801.46,FIND,0)),U,2)'=PKG Q
  1. S NODE=$G(^PXRMD(801.46,FIND,3))
  1. S NDATA=$P(NODE,U,2) I NDATA=1 Q
  1. S CID=$P(NODE,U,3),TYPE=$P(NODE,U)
  1. F X=1,2 D
  1. .S NODE=$G(^PXRMD(801.46,FIND,X))
  1. .S SUB=$P(NODE,U,3) Q:SUB=""
  1. .S FINDINGS(SUB)=FILE_U_$P(NODE,U,2)_U_TYPE_U_CID_U_PKG
  1. .I CID S FINDINGS("PXRM CID INDEX",$P(NODE,U,3))=""
  1. Q
  1. ;
  1. WH(FIEVAL) ;
  1. N ARRAY,DATE,ESUB,IDENT,DATE,NODE,STR,WVIEN
  1. S IDENT=$P($G(^PXRMD(801.41,DITEM,0)),U,16)
  1. I $G(FIEVAL(1,"LINK"))=1,$G(FIEVAL(1,"STATUS"))="OPEN",$G(FIEVAL(1,"VALUE"))="Pending" D
  1. .S WVIEN=$G(FIEVAL(1,"WVIEN"))
  1. .D RESULTS^WVALERTS(.ARRAY,WVIEN) D
  1. ..K WHFIND,WHNAME
  1. ..S NODE=$G(ARRAY(0)) I +$P(NODE,U)'>0 Q
  1. ..S WHFIND=WVIEN_";WV(790.1,",WHNAME=$P($G(NODE),U,3)
  1. ..S (ESUB,SUB)=0 F S SUB=$O(DTXT(SUB)) Q:SUB'>0 S ESUB=SUB
  1. ..S ESUB=ESUB+1
  1. ..I IDENT="WHRP" D
  1. ...N MOD
  1. ...S DATE=""
  1. ...S DTXT(ESUB)=$P($G(NODE),U,3),ESUB=ESUB+1
  1. ...S DATE=$P($G(NODE),U,4),STR=$$RJ^XLFSTR("Collected: ",20)
  1. ...S STR=STR_$P($G(NODE),U,8)
  1. ...S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ...S STR=$$RJ^XLFSTR("Lab Accession #: ",20),STR=STR_$P($G(NODE),U,9)
  1. ...S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ...S STR=$$RJ^XLFSTR("Specimen: ",20),STR=STR_$P($G(NODE),U,10)
  1. ...S DTXT(ESUB)=STR
  1. ..I IDENT="WHRM" D
  1. ...S STR=$$RJ^XLFSTR("Procedure: ",20),STR=STR_$P($G(NODE),U,5)
  1. ...S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ...S STR=$$RJ^XLFSTR("Primary Diagnosis: ",20),STR=STR_$P($G(NODE),U,6)
  1. ...S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ...S STR=$$RJ^XLFSTR("Modifiers: ",20),MOD=$P($G(NODE),U,7)
  1. ...I $G(MOD)="" S STR=STR_"<none>"
  1. ...E S STR=STR_$P($G(MOD),"~",1)
  1. ...S DTXT(ESUB)=STR,ESUB=ESUB+1
  1. ...I $P($G(MOD),"~",2)'="" S DTXT(ESUB)=$$LJ^XLFSTR($P(MOD,"~",2),23)
  1. Q
  1. ;