- PXRMDLLB ;SLC/PJH - REMINDER DIALOG LOADER ;01/02/2014
- ;;2.0;CLINICAL REMINDERS;**6,12,16,26**;Feb 04, 2005;Build 404
- ;
- ;
- CODES(TXIEN,CODESYS,ARRAY) ;
- N CNT,CODE,DATES,END,IEN,NODE,START,TEXT,TYPE
- S CNT=0
- S TYPE="" F S TYPE=$O(CODESYS(TYPE)) Q:TYPE="" D
- .S CODE="" F S CODE=$O(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE)) Q:CODE="" D
- ..S START="" F S START=$O(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START)) Q:START="" D
- ...S END="" F S END=$O(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START,END)) Q:END="" D
- ....S NODE=$G(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START,END)) I NODE="" Q
- ....S IEN=$P(NODE,U),TEXT=$P(NODE,U,2)
- ....S DATES=START_":"_$S(END>0:END,1:"")
- ....S CNT=CNT+1,ARRAY(CNT)=IEN_U_$G(CODE)_":"_$G(DATES)_U_$G(TEXT)
- Q
- ;
- EXPTAX(DITEM,TIEN,DCUR) ;
- ;this function handles taxonomy that are set to not display.
- N CAT,DTTYP,FIND,FILE,NODE,TSEL
- S NODE=$G(^PXRMD(801.41,DITEM,"TAX"))
- S TSEL=$P(NODE,U)
- I "ND"[TSEL D EXP(DITEM,TIEN,DCUR,"CPT",3)
- I "NP"[TSEL D EXP(DITEM,TIEN,DCUR,"POV",3)
- Q
- ;
- ;
- EXP(DITEM,TIEN,DCUR,DTTYP,TYPE) ;Expand taxonomy codes
- N CAT,CODES,CODETYPE,CNT,ENC,FILE,LIT
- I DTTYP="" Q
- ;S FILE=$S(DTTYP="POV":80,DTTYP="CPT":81,1:"") Q:'FILE
- S LIT="Selectable "_$S(DTTYP="POV":"Diagnoses:",1:"Procedures:")
- S CAT=$P($G(^PXD(811.2,TIEN,0)),U)
- ;
- D BLDCODE^PXRMDTAX(DTTYP,.CODETYPE)
- ;I FILE=80 S CODETYPE("ICD")="",CODETYPE("10D")=""
- ;I FILE=81 S CODETYPE("CPT")=""
- S OCNT=OCNT+1
- I TYPE=5 S ORY(OCNT)=3_U_DITEM_U_U_DTTYP_U_1_U_U_U_U_CAT_U_LIT
- ;Get selectable codes
- D CODES(TIEN,.CODETYPE,.CODES)
- S CNT=0
- ;Save selectable codes as type 5 or 3 records
- F S CNT=$O(CODES(CNT)) Q:'CNT D
- .S OCNT=OCNT+1,ORY(OCNT)=TYPE_U_DITEM_U_U_DTTYP_U_U_CODES(CNT)
- Q
- ;
- ;Pass MST code as a forced value
- MST(DFTYP,DFIEN) ;
- ;Validate finding ien
- Q:DFIEN=""
- ;For each MST term check if finding is mapped
- N FOUND,TCOND,TIEN,TNAM,TSUB
- S FOUND=0
- F TNAM="POSITIVE","NEGATIVE","DECLINES" D Q:FOUND
- .;Get term IEN
- .S TIEN=$O(^PXRMD(811.5,"B","MST "_TNAM_" REPORT","")) Q:'TIEN
- .;Check if finding is mapped to term
- .Q:'$D(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN))
- .;If exam and term condition logic is null ignore
- .I DFTYP="AUTTEXAM(" D Q:TCOND=""
- ..S TCOND="",TSUB=$O(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN,"")) Q:'TSUB
- ..S TCOND=$P($G(^PXRMD(811.5,TIEN,20,TSUB,3)),U)
- .;If it is then create additional prompt for MST
- .N DSEQ,DEXC,DDEF,DGUI,DTYP,DTEXT,DSNL,DREQ
- .;Add to end of array
- .S DSEQ=$O(ARRAY(""),-1)+1
- .;Null fields
- .S DDEF="",DEXC="",DTEXT="",DSNL="",DREQ=""
- .;MST status (exept for exams)
- .I DFTYP'="AUTTEXAM(" S DDEF=$$STCODE^PXRMMST("MST "_TNAM_" REPORT")
- .;GUI process and forced value
- .S DGUI="MST",DTYP="F"
- .;Save in array
- .S ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
- .;Quit after the first term is found
- .S FOUND=1
- Q
- ;
- REPLACE(DFN,TERMNODE,DITEM,DATA,TERMSTAT) ;
- ;this section is use to compare the term evalution result against
- ;the value store in the Reminder Term Status field.
- ;If the value match and the replacement item is active then the orginal
- ;item will be replace with the new item.
- N TERMOUT
- S TERMSTAT=1 I +$P(TERMNODE,U),$P($G(TERMNODE),U,2)'="" D Q:+TERMSTAT=0
- .N DITEMO
- .S TERMOUT=$$TERM($P(TERMNODE,U),DFN,$G(DITEM),"D")
- .I TERMOUT'=$P(TERMNODE,U,2) Q
- .I +$P(TERMNODE,U,3)'>0 S TERMSTAT=0 Q
- .S DITEMO=DITEM,DITEM=$P(TERMNODE,U,3),DATA=$G(^PXRMD(801.41,DITEM,0))
- .I $G(DATA)=""!($$ISDISAB^PXRMDLL(DITEM)=1) S DITEM=$O(^PXRMD(801.41,"B","VA-DISABLE BRANCHING LOGIC REPLACEMENT ELEMENT","")) Q
- Q
- ;
- RESGROUP(DIEN) ;
- N CNT,RESULT,TEMP
- S RESULT=""
- I $$PATCH^XPDUTL("OR*3.0*243")=0 D Q RESULT
- .S RESULT=$P($G(^PXRMD(801.41,DIEN,51,1,0)),U) I RESULT="" Q
- .I $$ISDISAB^PXRMDLL(RESULT)=1 S RESULT="" Q
- S CNT=0 F S CNT=$O(^PXRMD(801.41,DIEN,51,CNT)) Q:CNT'>0 D
- .S TEMP=$P($G(^PXRMD(801.41,DIEN,51,CNT,0)),U) I TEMP="" Q
- .I $$ISDISAB^PXRMDLL(TEMP)=1 S TEMP="" Q
- .S RESULT=$S(RESULT="":TEMP,1:RESULT_"~"_TEMP)
- Q RESULT
- ;
- TERM(TERMIEN,DFN,IEN,TYPE) ;
- ;this section is use to for the term evaluation
- N ARRAY,CNT,NODE,RESULT,STR,TERMARR
- N DATEORDR,ESUB,FINDPA,FIEVAL,TFIEVAL,NOCC,BDT,EDT,SDIR,SUB,WVIEN
- S (TERMARR,TFIEVAL,DATEORDR,FIEVAL)=""
- ;build term array
- D TERM^PXRMLDR(TERMIEN,.TERMARR)
- ;term evaulation
- D IEVALTER^PXRMTERM(DFN,.TERMARR,.TERMARR,1,.FIEVAL)
- S RESULT=$G(FIEVAL(1))
- I TYPE="O" Q +RESULT
- ;if the item is one of the WH review reminders build finding item and
- ;text from the the WVALERTS API in PXRMCWH
- I RESULT=1,$P($G(^PXRMD(801.41,IEN,0)),U,16)["WHR" D
- .N IDENT,DATE
- .S IDENT=$P($G(^PXRMD(801.41,IEN,0)),U,16)
- .I $G(FIEVAL(1,"LINK"))=1,$G(FIEVAL(1,"STATUS"))="OPEN",$G(FIEVAL(1,"VALUE"))="Pending" D
- ..S WVIEN=$G(FIEVAL(1,"WVIEN"))
- ..;DBIA #4102
- ..D RESULTS^WVALERTS(.ARRAY,WVIEN) D
- ...K WHFIND,WHNAME
- ...S NODE=$G(ARRAY(0)) I +$P(NODE,U)'>0 Q
- ...S WHFIND=WVIEN_";WV(790.1,",WHNAME=$P($G(NODE),U,3)
- ...S (ESUB,SUB)=0 F S SUB=$O(DTXT(SUB)) Q:SUB'>0 S ESUB=SUB
- ...S ESUB=ESUB+1
- ...I IDENT="WHRP" D
- ....N MOD
- ....S DATE=""
- ....S DTXT(ESUB)=$P($G(NODE),U,3),ESUB=ESUB+1
- ....S DATE=$P($G(NODE),U,4),STR=$$RJ^XLFSTR("Collected: ",20)
- ....S STR=STR_$P($G(NODE),U,8)
- ....S DTXT(ESUB)=STR,ESUB=ESUB+1
- ....S STR=$$RJ^XLFSTR("Lab Accession #: ",20),STR=STR_$P($G(NODE),U,9)
- ....S DTXT(ESUB)=STR,ESUB=ESUB+1
- ....S STR=$$RJ^XLFSTR("Specimen: ",20),STR=STR_$P($G(NODE),U,10)
- ....S DTXT(ESUB)=STR
- ...I IDENT="WHRM" D
- ....S STR=$$RJ^XLFSTR("Procedure: ",20),STR=STR_$P($G(NODE),U,5)
- ....S DTXT(ESUB)=STR,ESUB=ESUB+1
- ....S STR=$$RJ^XLFSTR("Primary Diagnosis: ",20),STR=STR_$P($G(NODE),U,6)
- ....S DTXT(ESUB)=STR,ESUB=ESUB+1
- ....S STR=$$RJ^XLFSTR("Modifiers: ",20),MOD=$P($G(NODE),U,7)
- ....I $G(MOD)="" S STR=STR_"<none>"
- ....E S STR=STR_$P($G(MOD),"~",1)
- ....S DTXT(ESUB)=STR,ESUB=ESUB+1
- ....I $P($G(MOD),"~",2)'="" S DTXT(ESUB)=$$LJ^XLFSTR($P(MOD,"~",2),23)
- Q +RESULT
- ;
- PXRMDLLB ;SLC/PJH - REMINDER DIALOG LOADER ;01/02/2014
- +1 ;;2.0;CLINICAL REMINDERS;**6,12,16,26**;Feb 04, 2005;Build 404
- +2 ;
- +3 ;
- CODES(TXIEN,CODESYS,ARRAY) ;
- +1 NEW CNT,CODE,DATES,END,IEN,NODE,START,TEXT,TYPE
- +2 SET CNT=0
- +3 SET TYPE=""
- FOR
- SET TYPE=$ORDER(CODESYS(TYPE))
- IF TYPE=""
- QUIT
- Begin DoDot:1
- +4 SET CODE=""
- FOR
- SET CODE=$ORDER(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE))
- IF CODE=""
- QUIT
- Begin DoDot:2
- +5 SET START=""
- FOR
- SET START=$ORDER(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START))
- IF START=""
- QUIT
- Begin DoDot:3
- +6 SET END=""
- FOR
- SET END=$ORDER(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START,END))
- IF END=""
- QUIT
- Begin DoDot:4
- +7 SET NODE=$GET(^PXD(811.2,TXIEN,20,"AUID",TYPE,CODE,START,END))
- IF NODE=""
- QUIT
- +8 SET IEN=$PIECE(NODE,U)
- SET TEXT=$PIECE(NODE,U,2)
- +9 SET DATES=START_":"_$SELECT(END>0:END,1:"")
- +10 SET CNT=CNT+1
- SET ARRAY(CNT)=IEN_U_$GET(CODE)_":"_$GET(DATES)_U_$GET(TEXT)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 QUIT
- +12 ;
- EXPTAX(DITEM,TIEN,DCUR) ;
- +1 ;this function handles taxonomy that are set to not display.
- +2 NEW CAT,DTTYP,FIND,FILE,NODE,TSEL
- +3 SET NODE=$GET(^PXRMD(801.41,DITEM,"TAX"))
- +4 SET TSEL=$PIECE(NODE,U)
- +5 IF "ND"[TSEL
- DO EXP(DITEM,TIEN,DCUR,"CPT",3)
- +6 IF "NP"[TSEL
- DO EXP(DITEM,TIEN,DCUR,"POV",3)
- +7 QUIT
- +8 ;
- +9 ;
- EXP(DITEM,TIEN,DCUR,DTTYP,TYPE) ;Expand taxonomy codes
- +1 NEW CAT,CODES,CODETYPE,CNT,ENC,FILE,LIT
- +2 IF DTTYP=""
- QUIT
- +3 ;S FILE=$S(DTTYP="POV":80,DTTYP="CPT":81,1:"") Q:'FILE
- +4 SET LIT="Selectable "_$SELECT(DTTYP="POV":"Diagnoses:",1:"Procedures:")
- +5 SET CAT=$PIECE($GET(^PXD(811.2,TIEN,0)),U)
- +6 ;
- +7 DO BLDCODE^PXRMDTAX(DTTYP,.CODETYPE)
- +8 ;I FILE=80 S CODETYPE("ICD")="",CODETYPE("10D")=""
- +9 ;I FILE=81 S CODETYPE("CPT")=""
- +10 SET OCNT=OCNT+1
- +11 IF TYPE=5
- SET ORY(OCNT)=3_U_DITEM_U_U_DTTYP_U_1_U_U_U_U_CAT_U_LIT
- +12 ;Get selectable codes
- +13 DO CODES(TIEN,.CODETYPE,.CODES)
- +14 SET CNT=0
- +15 ;Save selectable codes as type 5 or 3 records
- +16 FOR
- SET CNT=$ORDER(CODES(CNT))
- IF 'CNT
- QUIT
- Begin DoDot:1
- +17 SET OCNT=OCNT+1
- SET ORY(OCNT)=TYPE_U_DITEM_U_U_DTTYP_U_U_CODES(CNT)
- End DoDot:1
- +18 QUIT
- +19 ;
- +20 ;Pass MST code as a forced value
- MST(DFTYP,DFIEN) ;
- +1 ;Validate finding ien
- +2 IF DFIEN=""
- QUIT
- +3 ;For each MST term check if finding is mapped
- +4 NEW FOUND,TCOND,TIEN,TNAM,TSUB
- +5 SET FOUND=0
- +6 FOR TNAM="POSITIVE","NEGATIVE","DECLINES"
- Begin DoDot:1
- +7 ;Get term IEN
- +8 SET TIEN=$ORDER(^PXRMD(811.5,"B","MST "_TNAM_" REPORT",""))
- IF 'TIEN
- QUIT
- +9 ;Check if finding is mapped to term
- +10 IF '$DATA(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN))
- QUIT
- +11 ;If exam and term condition logic is null ignore
- +12 IF DFTYP="AUTTEXAM("
- Begin DoDot:2
- +13 SET TCOND=""
- SET TSUB=$ORDER(^PXRMD(811.5,TIEN,20,"E",DFTYP,DFIEN,""))
- IF 'TSUB
- QUIT
- +14 SET TCOND=$PIECE($GET(^PXRMD(811.5,TIEN,20,TSUB,3)),U)
- End DoDot:2
- IF TCOND=""
- QUIT
- +15 ;If it is then create additional prompt for MST
- +16 NEW DSEQ,DEXC,DDEF,DGUI,DTYP,DTEXT,DSNL,DREQ
- +17 ;Add to end of array
- +18 SET DSEQ=$ORDER(ARRAY(""),-1)+1
- +19 ;Null fields
- +20 SET DDEF=""
- SET DEXC=""
- SET DTEXT=""
- SET DSNL=""
- SET DREQ=""
- +21 ;MST status (exept for exams)
- +22 IF DFTYP'="AUTTEXAM("
- SET DDEF=$$STCODE^PXRMMST("MST "_TNAM_" REPORT")
- +23 ;GUI process and forced value
- +24 SET DGUI="MST"
- SET DTYP="F"
- +25 ;Save in array
- +26 SET ARRAY(DSEQ)=DGUI_U_DEXC_U_DDEF_U_DTYP_U_DTEXT_U_DSNL_U_DREQ
- +27 ;Quit after the first term is found
- +28 SET FOUND=1
- End DoDot:1
- IF FOUND
- QUIT
- +29 QUIT
- +30 ;
- REPLACE(DFN,TERMNODE,DITEM,DATA,TERMSTAT) ;
- +1 ;this section is use to compare the term evalution result against
- +2 ;the value store in the Reminder Term Status field.
- +3 ;If the value match and the replacement item is active then the orginal
- +4 ;item will be replace with the new item.
- +5 NEW TERMOUT
- +6 SET TERMSTAT=1
- IF +$PIECE(TERMNODE,U)
- IF $PIECE($GET(TERMNODE),U,2)'=""
- Begin DoDot:1
- +7 NEW DITEMO
- +8 SET TERMOUT=$$TERM($PIECE(TERMNODE,U),DFN,$GET(DITEM),"D")
- +9 IF TERMOUT'=$PIECE(TERMNODE,U,2)
- QUIT
- +10 IF +$PIECE(TERMNODE,U,3)'>0
- SET TERMSTAT=0
- QUIT
- +11 SET DITEMO=DITEM
- SET DITEM=$PIECE(TERMNODE,U,3)
- SET DATA=$GET(^PXRMD(801.41,DITEM,0))
- +12 IF $GET(DATA)=""!($$ISDISAB^PXRMDLL(DITEM)=1)
- SET DITEM=$ORDER(^PXRMD(801.41,"B","VA-DISABLE BRANCHING LOGIC REPLACEMENT ELEMENT",""))
- QUIT
- End DoDot:1
- IF +TERMSTAT=0
- QUIT
- +13 QUIT
- +14 ;
- RESGROUP(DIEN) ;
- +1 NEW CNT,RESULT,TEMP
- +2 SET RESULT=""
- +3 IF $$PATCH^XPDUTL("OR*3.0*243")=0
- Begin DoDot:1
- +4 SET RESULT=$PIECE($GET(^PXRMD(801.41,DIEN,51,1,0)),U)
- IF RESULT=""
- QUIT
- +5 IF $$ISDISAB^PXRMDLL(RESULT)=1
- SET RESULT=""
- QUIT
- End DoDot:1
- QUIT RESULT
- +6 SET CNT=0
- FOR
- SET CNT=$ORDER(^PXRMD(801.41,DIEN,51,CNT))
- IF CNT'>0
- QUIT
- Begin DoDot:1
- +7 SET TEMP=$PIECE($GET(^PXRMD(801.41,DIEN,51,CNT,0)),U)
- IF TEMP=""
- QUIT
- +8 IF $$ISDISAB^PXRMDLL(TEMP)=1
- SET TEMP=""
- QUIT
- +9 SET RESULT=$SELECT(RESULT="":TEMP,1:RESULT_"~"_TEMP)
- End DoDot:1
- +10 QUIT RESULT
- +11 ;
- TERM(TERMIEN,DFN,IEN,TYPE) ;
- +1 ;this section is use to for the term evaluation
- +2 NEW ARRAY,CNT,NODE,RESULT,STR,TERMARR
- +3 NEW DATEORDR,ESUB,FINDPA,FIEVAL,TFIEVAL,NOCC,BDT,EDT,SDIR,SUB,WVIEN
- +4 SET (TERMARR,TFIEVAL,DATEORDR,FIEVAL)=""
- +5 ;build term array
- +6 DO TERM^PXRMLDR(TERMIEN,.TERMARR)
- +7 ;term evaulation
- +8 DO IEVALTER^PXRMTERM(DFN,.TERMARR,.TERMARR,1,.FIEVAL)
- +9 SET RESULT=$GET(FIEVAL(1))
- +10 IF TYPE="O"
- QUIT +RESULT
- +11 ;if the item is one of the WH review reminders build finding item and
- +12 ;text from the the WVALERTS API in PXRMCWH
- +13 IF RESULT=1
- IF $PIECE($GET(^PXRMD(801.41,IEN,0)),U,16)["WHR"
- Begin DoDot:1
- +14 NEW IDENT,DATE
- +15 SET IDENT=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,16)
- +16 IF $GET(FIEVAL(1,"LINK"))=1
- IF $GET(FIEVAL(1,"STATUS"))="OPEN"
- IF $GET(FIEVAL(1,"VALUE"))="Pending"
- Begin DoDot:2
- +17 SET WVIEN=$GET(FIEVAL(1,"WVIEN"))
- +18 ;DBIA #4102
- +19 DO RESULTS^WVALERTS(.ARRAY,WVIEN)
- Begin DoDot:3
- +20 KILL WHFIND,WHNAME
- +21 SET NODE=$GET(ARRAY(0))
- IF +$PIECE(NODE,U)'>0
- QUIT
- +22 SET WHFIND=WVIEN_";WV(790.1,"
- SET WHNAME=$PIECE($GET(NODE),U,3)
- +23 SET (ESUB,SUB)=0
- FOR
- SET SUB=$ORDER(DTXT(SUB))
- IF SUB'>0
- QUIT
- SET ESUB=SUB
- +24 SET ESUB=ESUB+1
- +25 IF IDENT="WHRP"
- Begin DoDot:4
- +26 NEW MOD
- +27 SET DATE=""
- +28 SET DTXT(ESUB)=$PIECE($GET(NODE),U,3)
- SET ESUB=ESUB+1
- +29 SET DATE=$PIECE($GET(NODE),U,4)
- SET STR=$$RJ^XLFSTR("Collected: ",20)
- +30 SET STR=STR_$PIECE($GET(NODE),U,8)
- +31 SET DTXT(ESUB)=STR
- SET ESUB=ESUB+1
- +32 SET STR=$$RJ^XLFSTR("Lab Accession #: ",20)
- SET STR=STR_$PIECE($GET(NODE),U,9)
- +33 SET DTXT(ESUB)=STR
- SET ESUB=ESUB+1
- +34 SET STR=$$RJ^XLFSTR("Specimen: ",20)
- SET STR=STR_$PIECE($GET(NODE),U,10)
- +35 SET DTXT(ESUB)=STR
- End DoDot:4
- +36 IF IDENT="WHRM"
- Begin DoDot:4
- +37 SET STR=$$RJ^XLFSTR("Procedure: ",20)
- SET STR=STR_$PIECE($GET(NODE),U,5)
- +38 SET DTXT(ESUB)=STR
- SET ESUB=ESUB+1
- +39 SET STR=$$RJ^XLFSTR("Primary Diagnosis: ",20)
- SET STR=STR_$PIECE($GET(NODE),U,6)
- +40 SET DTXT(ESUB)=STR
- SET ESUB=ESUB+1
- +41 SET STR=$$RJ^XLFSTR("Modifiers: ",20)
- SET MOD=$PIECE($GET(NODE),U,7)
- +42 IF $GET(MOD)=""
- SET STR=STR_"<none>"
- +43 IF '$TEST
- SET STR=STR_$PIECE($GET(MOD),"~",1)
- +44 SET DTXT(ESUB)=STR
- SET ESUB=ESUB+1
- +45 IF $PIECE($GET(MOD),"~",2)'=""
- SET DTXT(ESUB)=$$LJ^XLFSTR($PIECE(MOD,"~",2),23)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +46 QUIT +RESULT
- +47 ;