- 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 ;
