VENPCC1L ; IHS/OIT/GIS - VERSION 2.5 EXTENSIONS ;
;;2.6;PCC+;;NOV 12, 2007
;
; MORE SPECIAL DATA MINING FOR 2.5
;
VER25(DFN,PRV,VISIT,DEFEF,DEPTIEN) ; EP-EXTENSIONS FOR VER 2.5
N TMP,PNL,%
S PNL="LAB"_U
S PNL=PNL_"VENPCC"
S PNL="I $L($T("_PNL_"S6)) D "_PNL_"S6(DFN,DEFEF)"
S TMP="^TMP(""VEN PRNT"",$J,1)"
CM D ACM(DFN) ; CASE MANAGEMENT FIELDS FOR VER 2.5
CC S %=$$CCTXT^VENPCCAM(VISIT) I $L(%) D CCMM(%) ; CHIEF COMPLAINT (c13) ; PATCHED BY GIS/OIT 7/21/06
MSR I $L($T(MSR^VENPCC1M)) D MSR^VENPCC1M(DFN,VISIT,DEFEF) ; MEASUREMENTS AND VITAL SIGNS FOR 2.5
AST I $L($T(RESP^VENPCC1M)),$D(^AUPNVAST("AC",DFN)) D RESP^VENPCC1M(DFN) ; ASTHMA MEASUREMENTS FOR 2.5
PNLAB I $P($G(^VEN(7.41,+$G(DEFEF),5)),U,22) X PNL I 1 ; SPECIAL PRENATAL LAB RESULTS DIAPLAY FOR VER 2.5
STDLAB E I $O(^VEN(7.41,+$G(DEFEF),7,0)),$L($T(LAB^VENPCC1N)) D LAB^VENPCC1N(DFN,DEFEF) ; GENL LAB DISPLAY FOR 2.5
I $D(^VEN(7.41,+$G(DEFEF),6)) X "I $L($T(GRAPH^VENPCCS3)) D GRAPH^VENPCCS3(DFN,DEFEF)" ; GRAPH RERSULTS VER 2.5
KB I $O(^VEN(7.41,+$G(DEFEF),16,0))!($O(^VEN(7.41,+$G(DEFEF),19,0))) X "I $L($T(FETCH^VENPCCK)) D FETCH^VENPCCK(DEFEF,DFN)" ; KNOWLEDGE BASE ; WCM UPGRADE
Q
;
CCMM(Y) ; EP-NEW CHIEF COMPLAINT USES V NARRATIVE TEXT VALUE IN Y
N I,X,MAX
S MAX=$P($G(^VEN(7.41,DEFEF,14)),U,8)
I 'MAX S MAX=240
S Y=$E(Y,1,MAX)
S @TMP@("c13")=$E(Y,1,240) ; STORED IN A GLOBAL SO LENGTH CANT BE > 240
Q
;
ACM(DFN) ; EP-CASE MGMT COMMEMTS
N TOT,CIEN,RIEN,WIEN,CMT,REG,STG,%,X,Y,Z
S TOT=19,RIEN=0
F S RIEN=$O(^ACM(41,"AC",DFN,RIEN)) Q:'RIEN S CIEN=^(RIEN) I $O(^ACM(41,CIEN,1,0)) D
. S STG="",WIEN=0
. F S WIEN=$O(^ACM(41,CIEN,1,WIEN)) Q:'WIEN D I $L(STG)>9999 Q ; PATCHED BY GIS/OIT 10/3/05 ; PCC+ 2.5 PATCH 1
.. S CMT=$G(^ACM(41,CIEN,1,WIEN,0)) I '$L(CMT) Q ; COMMENT
.. I '$L(STG) S STG=CMT Q
.. S X=$E(STG,$L(STG)) S Y=$E(CMT) S Z=""
.. I X'=" ",X'="-",Y'=" " S Z=" "
.. S STG=STG_Z_CMT
.. Q
. I '$L(STG) Q
. S REG=$P($G(^ACM(41.1,RIEN,0)),U) I '$L(REG) Q ; REGISTER NAME
. S STG=REG_": "_STG
. F %=10,13,34,39,94 I STG[$C(%) S STG=$TR(STG,$C(%),"") ; STRIP OFF FORBIDDEN CHARACTERS
. F Q:'$L(STG) S %=$E(STG,1,240) S STG=$E(STG,241,9999) S TOT=TOT+1 S @TMP@("u"_TOT)=% I TOT>29 Q
. Q
Q
;
ART(DFN) ; EP-ADVERSE REACTION TRACKING
N MAXNARR,MAX,DATE,CAUSE,RXN,TOT,NARR,AIEN,RIEN,ORXN,RXNIEN,FMDT,STOP,X
S STOP=0,TOT=0,MAX=$P($G(^VEN(7.41,+$G(DEFEF),2)),U,5) I 'MAX S MAX=5 ; MAX # OF ALLERGIES ALLOWED ON PCC+ FORM
S MAXNARR=$P($G(^VEN(7.41,+$G(DEFEF),14)),U,6) I 'MAXNARR S MAXNARR=32 ; MAX STG LENGTH
S AIEN=0 F S AIEN=$O(^GMR(120.8,"B",DFN,AIEN)) Q:'AIEN D I STOP Q ; LOOP THRU ART PATIENT INDEX
. S X=$G(^GMR(120.8,AIEN,0)) I '$L(X) Q
. I $D(^GMR(120.8,AIEN,"ER")) Q ; RXN HAS BEEN REMOVED ; PATCHED BY GIS 12/26/06
. S CAUSE=$P(X,U,2) I '$L(CAUSE) Q ; GET REACTANT
. S FMDT=$P(X,U,4),DATE="" ; GET DATE OF ADVERSE REACTION
. I FMDT S DATE=$$FMTE^XLFDT(FMDT,"2D")
. S RIEN=0,NARR=""
. I '$O(^GMR(120.8,AIEN,10,0)) S NARR=CAUSE_": Reaction??" ; PATCHED BY GIS/OIT 6/6/06 ; PCC + VERSION 2.5, PATCH 5
. F S RIEN=$O(^GMR(120.8,AIEN,10,RIEN)) Q:'RIEN D ; GET INDIVIDUAL REACTIONS
.. S Y=$G(^GMR(120.8,AIEN,10,RIEN,0)) I '$L(Y) Q
.. S RXNIEN=+Y,ORXN=$P(Y,U,2)
.. I $L(ORXN) S RXN=ORXN ; OTHER RXN
.. E S RXN=$P($G(^GMRD(120.83,RXNIEN,0)),U) ; STD REACTION FROM LIST
.. I '$L(RXN) S RXN="Unknown reaction" ; PATCHED BY GIS/OIT 2/1/06 ; PCC + VERSION 2.5, PATCH 4
.. I NARR="" S NARR=CAUSE_": "_RXN
.. E S NARR=NARR_","_RXN
.. Q
. I '$L(NARR) Q ; THERE MUSTBE A LEAST 1 DOCUMENTED RXN
. I $L(DATE) S NARR=NARR_" ("_DATE_")" ; APPEND THE DATE
. S TOT=TOT+1
. I TOT=(MAX+1) S STOP=1,@TMP@(1,("a"_MAX))="More allergies on Health Summary!" Q
. S @TMP@(1,("a"_TOT))=$E(NARR,1,MAXNARR) ; CREATE MAIL MERGE GLOBAL NODE
. Q
Q
;
VENPCC1L ; IHS/OIT/GIS - VERSION 2.5 EXTENSIONS ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ; MORE SPECIAL DATA MINING FOR 2.5
+4 ;
VER25(DFN,PRV,VISIT,DEFEF,DEPTIEN) ; EP-EXTENSIONS FOR VER 2.5
+1 NEW TMP,PNL,%
+2 SET PNL="LAB"_U
+3 SET PNL=PNL_"VENPCC"
+4 SET PNL="I $L($T("_PNL_"S6)) D "_PNL_"S6(DFN,DEFEF)"
+5 SET TMP="^TMP(""VEN PRNT"",$J,1)"
CM ; CASE MANAGEMENT FIELDS FOR VER 2.5
DO ACM(DFN)
CC ; CHIEF COMPLAINT (c13) ; PATCHED BY GIS/OIT 7/21/06
SET %=$$CCTXT^VENPCCAM(VISIT)
IF $LENGTH(%)
DO CCMM(%)
MSR ; MEASUREMENTS AND VITAL SIGNS FOR 2.5
IF $LENGTH($TEXT(MSR^VENPCC1M))
DO MSR^VENPCC1M(DFN,VISIT,DEFEF)
AST ; ASTHMA MEASUREMENTS FOR 2.5
IF $LENGTH($TEXT(RESP^VENPCC1M))
IF $DATA(^AUPNVAST("AC",DFN))
DO RESP^VENPCC1M(DFN)
PNLAB ; SPECIAL PRENATAL LAB RESULTS DIAPLAY FOR VER 2.5
IF $PIECE($GET(^VEN(7.41,+$GET(DEFEF),5)),U,22)
XECUTE PNL
IF 1
STDLAB ; GENL LAB DISPLAY FOR 2.5
IF '$TEST
IF $ORDER(^VEN(7.41,+$GET(DEFEF),7,0))
IF $LENGTH($TEXT(LAB^VENPCC1N))
DO LAB^VENPCC1N(DFN,DEFEF)
+1 ; GRAPH RERSULTS VER 2.5
IF $DATA(^VEN(7.41,+$GET(DEFEF),6))
XECUTE "I $L($T(GRAPH^VENPCCS3)) D GRAPH^VENPCCS3(DFN,DEFEF)"
KB ; KNOWLEDGE BASE ; WCM UPGRADE
IF $ORDER(^VEN(7.41,+$GET(DEFEF),16,0))!($ORDER(^VEN(7.41,+$GET(DEFEF),19,0)))
XECUTE "I $L($T(FETCH^VENPCCK)) D FETCH^VENPCCK(DEFEF,DFN)"
+1 QUIT
+2 ;
CCMM(Y) ; EP-NEW CHIEF COMPLAINT USES V NARRATIVE TEXT VALUE IN Y
+1 NEW I,X,MAX
+2 SET MAX=$PIECE($GET(^VEN(7.41,DEFEF,14)),U,8)
+3 IF 'MAX
SET MAX=240
+4 SET Y=$EXTRACT(Y,1,MAX)
+5 ; STORED IN A GLOBAL SO LENGTH CANT BE > 240
SET @TMP@("c13")=$EXTRACT(Y,1,240)
+6 QUIT
+7 ;
ACM(DFN) ; EP-CASE MGMT COMMEMTS
+1 NEW TOT,CIEN,RIEN,WIEN,CMT,REG,STG,%,X,Y,Z
+2 SET TOT=19
SET RIEN=0
+3 FOR
SET RIEN=$ORDER(^ACM(41,"AC",DFN,RIEN))
IF 'RIEN
QUIT
SET CIEN=^(RIEN)
IF $ORDER(^ACM(41,CIEN,1,0))
Begin DoDot:1
+4 SET STG=""
SET WIEN=0
+5 ; PATCHED BY GIS/OIT 10/3/05 ; PCC+ 2.5 PATCH 1
FOR
SET WIEN=$ORDER(^ACM(41,CIEN,1,WIEN))
IF 'WIEN
QUIT
Begin DoDot:2
+6 ; COMMENT
SET CMT=$GET(^ACM(41,CIEN,1,WIEN,0))
IF '$LENGTH(CMT)
QUIT
+7 IF '$LENGTH(STG)
SET STG=CMT
QUIT
+8 SET X=$EXTRACT(STG,$LENGTH(STG))
SET Y=$EXTRACT(CMT)
SET Z=""
+9 IF X'=" "
IF X'="-"
IF Y'=" "
SET Z=" "
+10 SET STG=STG_Z_CMT
+11 QUIT
End DoDot:2
IF $LENGTH(STG)>9999
QUIT
+12 IF '$LENGTH(STG)
QUIT
+13 ; REGISTER NAME
SET REG=$PIECE($GET(^ACM(41.1,RIEN,0)),U)
IF '$LENGTH(REG)
QUIT
+14 SET STG=REG_": "_STG
+15 ; STRIP OFF FORBIDDEN CHARACTERS
FOR %=10,13,34,39,94
IF STG[$CHAR(%)
SET STG=$TRANSLATE(STG,$CHAR(%),"")
+16 FOR
IF '$LENGTH(STG)
QUIT
SET %=$EXTRACT(STG,1,240)
SET STG=$EXTRACT(STG,241,9999)
SET TOT=TOT+1
SET @TMP@("u"_TOT)=%
IF TOT>29
QUIT
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
ART(DFN) ; EP-ADVERSE REACTION TRACKING
+1 NEW MAXNARR,MAX,DATE,CAUSE,RXN,TOT,NARR,AIEN,RIEN,ORXN,RXNIEN,FMDT,STOP,X
+2 ; MAX # OF ALLERGIES ALLOWED ON PCC+ FORM
SET STOP=0
SET TOT=0
SET MAX=$PIECE($GET(^VEN(7.41,+$GET(DEFEF),2)),U,5)
IF 'MAX
SET MAX=5
+3 ; MAX STG LENGTH
SET MAXNARR=$PIECE($GET(^VEN(7.41,+$GET(DEFEF),14)),U,6)
IF 'MAXNARR
SET MAXNARR=32
+4 ; LOOP THRU ART PATIENT INDEX
SET AIEN=0
FOR
SET AIEN=$ORDER(^GMR(120.8,"B",DFN,AIEN))
IF 'AIEN
QUIT
Begin DoDot:1
+5 SET X=$GET(^GMR(120.8,AIEN,0))
IF '$LENGTH(X)
QUIT
+6 ; RXN HAS BEEN REMOVED ; PATCHED BY GIS 12/26/06
IF $DATA(^GMR(120.8,AIEN,"ER"))
QUIT
+7 ; GET REACTANT
SET CAUSE=$PIECE(X,U,2)
IF '$LENGTH(CAUSE)
QUIT
+8 ; GET DATE OF ADVERSE REACTION
SET FMDT=$PIECE(X,U,4)
SET DATE=""
+9 IF FMDT
SET DATE=$$FMTE^XLFDT(FMDT,"2D")
+10 SET RIEN=0
SET NARR=""
+11 ; PATCHED BY GIS/OIT 6/6/06 ; PCC + VERSION 2.5, PATCH 5
IF '$ORDER(^GMR(120.8,AIEN,10,0))
SET NARR=CAUSE_": Reaction??"
+12 ; GET INDIVIDUAL REACTIONS
FOR
SET RIEN=$ORDER(^GMR(120.8,AIEN,10,RIEN))
IF 'RIEN
QUIT
Begin DoDot:2
+13 SET Y=$GET(^GMR(120.8,AIEN,10,RIEN,0))
IF '$LENGTH(Y)
QUIT
+14 SET RXNIEN=+Y
SET ORXN=$PIECE(Y,U,2)
+15 ; OTHER RXN
IF $LENGTH(ORXN)
SET RXN=ORXN
+16 ; STD REACTION FROM LIST
IF '$TEST
SET RXN=$PIECE($GET(^GMRD(120.83,RXNIEN,0)),U)
+17 ; PATCHED BY GIS/OIT 2/1/06 ; PCC + VERSION 2.5, PATCH 4
IF '$LENGTH(RXN)
SET RXN="Unknown reaction"
+18 IF NARR=""
SET NARR=CAUSE_": "_RXN
+19 IF '$TEST
SET NARR=NARR_","_RXN
+20 QUIT
End DoDot:2
+21 ; THERE MUSTBE A LEAST 1 DOCUMENTED RXN
IF '$LENGTH(NARR)
QUIT
+22 ; APPEND THE DATE
IF $LENGTH(DATE)
SET NARR=NARR_" ("_DATE_")"
+23 SET TOT=TOT+1
+24 IF TOT=(MAX+1)
SET STOP=1
SET @TMP@(1,("a"_MAX))="More allergies on Health Summary!"
QUIT
+25 ; CREATE MAIL MERGE GLOBAL NODE
SET @TMP@(1,("a"_TOT))=$EXTRACT(NARR,1,MAXNARR)
+26 QUIT
End DoDot:1
IF STOP
QUIT
+27 QUIT
+28 ;
