VENPCC1K ; IHS/OIT/GIS - SPECIAL DISPLAY OF PROBLEMS AND POVS ;
;;2.6;PCC+;;NOV 12, 2007
;
; SPECIAL PROBLEM DISPLAY FOR VER 2.5
;
PROB(DFN,DEPTIEN) ; EP - SPECIAL PROBLEM DISPLAY
N TMP
S TMP="^TMP(""VEN PRNT"",$J)"
D APL(DFN) ; ACTIVE PROBLEMS
I $G(DEFEF),$P($G(^VEN(7.41,DEFEF,5)),U,17)>1,$L($T(PCCPLUS^APCHSPRN)) D PCCPLUS^APCHSPRN(DFN,DEFEF) ; PROBLEM NARRATIVE LOOKUP FOR ANMC
D POV(DFN) ; ALL RECENT POVS
N CSIEN
S CSIEN=$P($G(^VEN(7.95,DEPTIEN,0)),U,4) I 'CSIEN Q
D CSPOV(DFN,CSIEN) ; CLINIC SPECIFIC POVS
Q
;
APL(DFN) ; EP-GET UP TO 25 ACTIVE PROBLEMS STORED IN pb1-pb25 AND CODES IN pb1c-pb25c
NEW TOT,PIEN,X,NIEN,IIEN,STAT,TYPE,NARR,VAR,VAR1,ICD,MAXNARR
S TOT=0,PIEN=0,MAXNARR=$$MAXNARR^VENPCCU(+$G(DEFEF))
F S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN D I TOT>24 Q
. S X=$G(^AUPNPROB(PIEN,0)),NIEN=$P(X,U,5),IIEN=+X,STAT=$P(X,U,12),TYPE=$P(X,4,U)
. I NIEN,IIEN,STAT="A",TYPE=""
. E Q
. S NARR=$G(^AUTNPOV(NIEN,0)),ICD=$P($G(^ICD9(IIEN,0)),U),ICD9(IIEN)=""
. S TOT=TOT+1
. S VAR="pb"_TOT,VAR1=VAR_"c"
. S @TMP@(1,VAR)=$E(NARR,1,MAXNARR),@TMP@(1,VAR1)=ICD
. Q
Q
;
POV(DFN) ; EP-GET UP TO 30 MOST RECENT POVS
; DATA STORED IN MAIL MERGE FIELD PAIRS pv1 - pv30
N PIEN,X,NIEN,IIEN,TOT,NARR,VAR,VAR1,ICD,DATE,Y,VISIT,MAXNARR,VCN
S TOT=0,PIEN=999999999,MAXNARR=$$MAXNARR^VENPCCU(+$G(DEFEF))
F S PIEN=$O(^AUPNVPOV("AC",DFN,PIEN),-1) Q:'PIEN D I TOT>29 Q
. S VISIT=$P($G(^AUPNVPOV(PIEN,0)),U,3) I 'VISIT Q
. S Y=+$G(^AUPNVSIT(VISIT,0))
. S DATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) I '$L(DATE) Q
. S X=$G(^AUPNVPOV(PIEN,0)),NIEN=$P(X,U,4),IIEN=+X
. S NARR=$G(^AUTNPOV(+$G(NIEN),0)),ICD=$$FVICD^VENPCCU(PIEN)
. I '$L(NARR) S NARR=$P($G(^ICD9(IIEN,0)),U,3) I '$L(NARR) S NARR="<missing narrative>"
. S TOT=TOT+1
. S VAR1="pv"_TOT
. S VCN="" ; VCN MAY BE APPENDED TO OUTPUT IF EF FLD 5.21 = 2
. I $P($G(^VEN(7.41,+$G(DEFEF),5)),U,21) S %=$P($G(^AUPNVSIT(VISIT,11)),U,3) I $L(%) S VCN=" "_%
. S @TMP@(1,VAR1)=DATE_" "_$E(NARR,1,MAXNARR)_" ["_ICD_"]"_VCN
. Q
Q
;
CSPOV(DFN,CSIEN) ; EP-GET UP TO 30 MOST RECENT POVS FOR THIS CLINIC
; DATA STORED IN MAIL MERGE FIELD pv1C THRU pv30C
N PIEN,X,NIEN,IIEN,TOT,NARR,VAR,ICD,VISIT,VCS,DATE,Y,MAXNARR,VCN
S TOT=0,PIEN=999999999,MAXNARR=$$MAXNARR^VENPCCU(+$G(DEFEF))
F S PIEN=$O(^AUPNVPOV("AC",DFN,PIEN),-1) Q:'PIEN D I TOT>29 Q
. S VISIT=$P($G(^AUPNVPOV(PIEN,0)),U,3) I 'VISIT Q
. S VCS=$P($G(^AUPNVSIT(VISIT,0)),U,8) I VCS'=CSIEN Q ; CLINIC STOP FILTER
. S Y=+$G(^AUPNVSIT(VISIT,0)) I '$L(Y) Q
. S DATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
. S X=$G(^AUPNVPOV(PIEN,0)),NIEN=$P(X,U,4),IIEN=+X
. S NARR=$G(^AUTNPOV(+$G(NIEN),0)),ICD=$$FVICD^VENPCCU(PIEN)
. I '$L(NARR) S NARR=$P($G(^ICD9(IIEN,0)),U,3) I '$L(NARR) S NARR="<missing narrative>"
. S TOT=TOT+1
. S VAR="pv"_TOT_"c"
. S VCN="" ; VCN MAY BE APPENDED TO OUTPUT IF EF FLD 5.21 = 2
. I $P($G(^VEN(7.41,+$G(DEFEF),5)),U,21) S %=$P($G(^AUPNVSIT(VISIT,11)),U,3) I $L(%) S VCN=" "_%
. S @TMP@(1,VAR)=DATE_" "_$E(NARR,1,MAXNARR)_" ["_ICD_"]"_VCN
. Q
Q
;
MH(DFN) ; EP-GET 15 MOST RECENT MENTAL HEALTH VISITS
; DATA IS STORED IN mh1-mh15
N PIEN,X,NIEN,IIEN,TOT,NARR,VAR,ICD,VISIT,VCS,DATE,Y,MAXNARR
S TOT=0,PIEN=999999999,MAXNARR=$$MAXNARR^VENPCCU(+$G(DEFEF))
F S PIEN=$O(^AUPNVPOV("AC",DFN,PIEN),-1) Q:'PIEN D I TOT>14 Q
. S VISIT=$P($G(^AUPNVPOV(PIEN,0)),U,3) I 'VISIT Q
. S Y=+$G(^AUPNVSIT(VISIT,0))
. S DATE=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3) I '$L(DATE) Q
. S X=$G(^AUPNVPOV(PIEN,0)),NIEN=$P(X,U,4),IIEN=+X I 'IIEN Q
. S ICD=$$FVICD^VENPCCU(PIEN) I '$L(ICD) Q
. I +ICD<290!(+ICD>319.999999) Q ; FILTER OUT NON MENTAL HEALTH DXS
. S NARR=$G(^AUTNPOV(+$G(NIEN),0))
. I '$L(NARR) S NARR=$P($G(^ICD9(IIEN,0)),U,3) I '$L(NARR) S NARR="<missing narrative>"
. S NARR=NARR
. S TOT=TOT+1
. S VAR="mh"_TOT
. S @TMP@(1,VAR)=DATE_" "_$E(NARR,1,MAXNARR)_" ["_ICD_"]"
. Q
Q
;
ORLOG(DFN) ; EP-SURGERY HX BASED ON ANMC OR LOG
; FOR ANMC ONLY
I '$D(^AZAORM(1,+$G(DFN),1)) Q "" ; MUST HAVE A VALID DFN
N DN,SN,PN,DATE,TOT,SURGEON,PNARR,ICD,DATE,X,Y,%,GBL,OUT,SIEN,STG
S GBL="^AZAORM(1,"_DFN_",1)",TOT=0,DN=999999999,OUT=""
F S DN=$O(@GBL@(DN),-1) Q:'DN D
. S Y=$P($G(@GBL@(DN,0)),U)\1 I 'Y Q
. X ^DD("DD") S DATE=Y
. S SN=0
. F S SN=$O(@GBL@(DN,1,SN)) Q:'SN D
.. S SIEN=+$G(@GBL@(DN,1,SN,0)) I 'SIEN Q
.. S %=U_"DIC("_16_")",SURGEON=$P($G(@%@(SIEN,0)),U) I '$L(SURGEON) Q
.. S PN=0
.. F S PN=$O(@GBL@(DN,1,SN,4,PN)) Q:'PN D
... S STG=$G(@GBL@(DN,1,SN,4,PN,0)) I '$L(STG) Q
... S PNARR=$P(STG,U) I '$L(PNARR) Q
... S %=$P(STG,U,2)
... S ICD=$P($G(^ICD0(+%,0)),U)
... S TOT=TOT+1
... S $P(OUT,U,TOT)=(DATE_";"_PNARR_";"_ICD_";"_SURGEON)
... Q
.. Q
. Q
Q OUT
;
SURG(DFN,DEFEF) ; EP - PRINT THE SURGICAL HX FROM THE OR LOG ON THE PCC+ FORM IN MERGE FIELDS u1-u15
; FOR ANMC ONLY
I '$D(^AZAORM(1,+$G(DFN))) Q ; MUST HAVE A VILD ER LOG DFN
N VAR,STG,X,Y,%,TOT,CASE,I,MAX
S STG=$$ORLOG(DFN) I '$L(STG) Q
S MAX=$L(STG,U) I MAX>15 S MAX=15
F TOT=1:1:MAX S CASE=$P(STG,U,TOT) I $L(CASE) D
. S X=$P(CASE,";")_" "_$P(CASE,";",2) ; PRINT DATE AND PROCEDURE NARRATIVE
. I $P($G(^VEN(7.41,DEFEF,5)),U,19) S X=X_" "_$P(CASE,";",3) ; PRINT THE ICD PROCEDURE CODE
. I $P($G(^VEN(7.41,DEFEF,5)),U,20) S Y=$P(CASE,";"),X=X_" DR. "_$E($P(Y,",",2))_". "_$P(Y,",") ; PRINT THE SURGEON
. S VAR="u"_TOT
. S @TMP@(1,VAR)=X
. Q
Q
;
VENPCC1K ; IHS/OIT/GIS - SPECIAL DISPLAY OF PROBLEMS AND POVS ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ; SPECIAL PROBLEM DISPLAY FOR VER 2.5
+4 ;
PROB(DFN,DEPTIEN) ; EP - SPECIAL PROBLEM DISPLAY
+1 NEW TMP
+2 SET TMP="^TMP(""VEN PRNT"",$J)"
+3 ; ACTIVE PROBLEMS
DO APL(DFN)
+4 ; PROBLEM NARRATIVE LOOKUP FOR ANMC
IF $GET(DEFEF)
IF $PIECE($GET(^VEN(7.41,DEFEF,5)),U,17)>1
IF $LENGTH($TEXT(PCCPLUS^APCHSPRN))
DO PCCPLUS^APCHSPRN(DFN,DEFEF)
+5 ; ALL RECENT POVS
DO POV(DFN)
+6 NEW CSIEN
+7 SET CSIEN=$PIECE($GET(^VEN(7.95,DEPTIEN,0)),U,4)
IF 'CSIEN
QUIT
+8 ; CLINIC SPECIFIC POVS
DO CSPOV(DFN,CSIEN)
+9 QUIT
+10 ;
APL(DFN) ; EP-GET UP TO 25 ACTIVE PROBLEMS STORED IN pb1-pb25 AND CODES IN pb1c-pb25c
+1 NEW TOT,PIEN,X,NIEN,IIEN,STAT,TYPE,NARR,VAR,VAR1,ICD,MAXNARR
+2 SET TOT=0
SET PIEN=0
SET MAXNARR=$$MAXNARR^VENPCCU(+$GET(DEFEF))
+3 FOR
SET PIEN=$ORDER(^AUPNPROB("AC",DFN,PIEN))
IF 'PIEN
QUIT
Begin DoDot:1
+4 SET X=$GET(^AUPNPROB(PIEN,0))
SET NIEN=$PIECE(X,U,5)
SET IIEN=+X
SET STAT=$PIECE(X,U,12)
SET TYPE=$PIECE(X,4,U)
+5 IF NIEN
IF IIEN
IF STAT="A"
IF TYPE=""
+6 IF '$TEST
QUIT
+7 SET NARR=$GET(^AUTNPOV(NIEN,0))
SET ICD=$PIECE($GET(^ICD9(IIEN,0)),U)
SET ICD9(IIEN)=""
+8 SET TOT=TOT+1
+9 SET VAR="pb"_TOT
SET VAR1=VAR_"c"
+10 SET @TMP@(1,VAR)=$EXTRACT(NARR,1,MAXNARR)
SET @TMP@(1,VAR1)=ICD
+11 QUIT
End DoDot:1
IF TOT>24
QUIT
+12 QUIT
+13 ;
POV(DFN) ; EP-GET UP TO 30 MOST RECENT POVS
+1 ; DATA STORED IN MAIL MERGE FIELD PAIRS pv1 - pv30
+2 NEW PIEN,X,NIEN,IIEN,TOT,NARR,VAR,VAR1,ICD,DATE,Y,VISIT,MAXNARR,VCN
+3 SET TOT=0
SET PIEN=999999999
SET MAXNARR=$$MAXNARR^VENPCCU(+$GET(DEFEF))
+4 FOR
SET PIEN=$ORDER(^AUPNVPOV("AC",DFN,PIEN),-1)
IF 'PIEN
QUIT
Begin DoDot:1
+5 SET VISIT=$PIECE($GET(^AUPNVPOV(PIEN,0)),U,3)
IF 'VISIT
QUIT
+6 SET Y=+$GET(^AUPNVSIT(VISIT,0))
+7 SET DATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
IF '$LENGTH(DATE)
QUIT
+8 SET X=$GET(^AUPNVPOV(PIEN,0))
SET NIEN=$PIECE(X,U,4)
SET IIEN=+X
+9 SET NARR=$GET(^AUTNPOV(+$GET(NIEN),0))
SET ICD=$$FVICD^VENPCCU(PIEN)
+10 IF '$LENGTH(NARR)
SET NARR=$PIECE($GET(^ICD9(IIEN,0)),U,3)
IF '$LENGTH(NARR)
SET NARR="<missing narrative>"
+11 SET TOT=TOT+1
+12 SET VAR1="pv"_TOT
+13 ; VCN MAY BE APPENDED TO OUTPUT IF EF FLD 5.21 = 2
SET VCN=""
+14 IF $PIECE($GET(^VEN(7.41,+$GET(DEFEF),5)),U,21)
SET %=$PIECE($GET(^AUPNVSIT(VISIT,11)),U,3)
IF $LENGTH(%)
SET VCN=" "_%
+15 SET @TMP@(1,VAR1)=DATE_" "_$EXTRACT(NARR,1,MAXNARR)_" ["_ICD_"]"_VCN
+16 QUIT
End DoDot:1
IF TOT>29
QUIT
+17 QUIT
+18 ;
CSPOV(DFN,CSIEN) ; EP-GET UP TO 30 MOST RECENT POVS FOR THIS CLINIC
+1 ; DATA STORED IN MAIL MERGE FIELD pv1C THRU pv30C
+2 NEW PIEN,X,NIEN,IIEN,TOT,NARR,VAR,ICD,VISIT,VCS,DATE,Y,MAXNARR,VCN
+3 SET TOT=0
SET PIEN=999999999
SET MAXNARR=$$MAXNARR^VENPCCU(+$GET(DEFEF))
+4 FOR
SET PIEN=$ORDER(^AUPNVPOV("AC",DFN,PIEN),-1)
IF 'PIEN
QUIT
Begin DoDot:1
+5 SET VISIT=$PIECE($GET(^AUPNVPOV(PIEN,0)),U,3)
IF 'VISIT
QUIT
+6 ; CLINIC STOP FILTER
SET VCS=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,8)
IF VCS'=CSIEN
QUIT
+7 SET Y=+$GET(^AUPNVSIT(VISIT,0))
IF '$LENGTH(Y)
QUIT
+8 SET DATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
+9 SET X=$GET(^AUPNVPOV(PIEN,0))
SET NIEN=$PIECE(X,U,4)
SET IIEN=+X
+10 SET NARR=$GET(^AUTNPOV(+$GET(NIEN),0))
SET ICD=$$FVICD^VENPCCU(PIEN)
+11 IF '$LENGTH(NARR)
SET NARR=$PIECE($GET(^ICD9(IIEN,0)),U,3)
IF '$LENGTH(NARR)
SET NARR="<missing narrative>"
+12 SET TOT=TOT+1
+13 SET VAR="pv"_TOT_"c"
+14 ; VCN MAY BE APPENDED TO OUTPUT IF EF FLD 5.21 = 2
SET VCN=""
+15 IF $PIECE($GET(^VEN(7.41,+$GET(DEFEF),5)),U,21)
SET %=$PIECE($GET(^AUPNVSIT(VISIT,11)),U,3)
IF $LENGTH(%)
SET VCN=" "_%
+16 SET @TMP@(1,VAR)=DATE_" "_$EXTRACT(NARR,1,MAXNARR)_" ["_ICD_"]"_VCN
+17 QUIT
End DoDot:1
IF TOT>29
QUIT
+18 QUIT
+19 ;
MH(DFN) ; EP-GET 15 MOST RECENT MENTAL HEALTH VISITS
+1 ; DATA IS STORED IN mh1-mh15
+2 NEW PIEN,X,NIEN,IIEN,TOT,NARR,VAR,ICD,VISIT,VCS,DATE,Y,MAXNARR
+3 SET TOT=0
SET PIEN=999999999
SET MAXNARR=$$MAXNARR^VENPCCU(+$GET(DEFEF))
+4 FOR
SET PIEN=$ORDER(^AUPNVPOV("AC",DFN,PIEN),-1)
IF 'PIEN
QUIT
Begin DoDot:1
+5 SET VISIT=$PIECE($GET(^AUPNVPOV(PIEN,0)),U,3)
IF 'VISIT
QUIT
+6 SET Y=+$GET(^AUPNVSIT(VISIT,0))
+7 SET DATE=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
IF '$LENGTH(DATE)
QUIT
+8 SET X=$GET(^AUPNVPOV(PIEN,0))
SET NIEN=$PIECE(X,U,4)
SET IIEN=+X
IF 'IIEN
QUIT
+9 SET ICD=$$FVICD^VENPCCU(PIEN)
IF '$LENGTH(ICD)
QUIT
+10 ; FILTER OUT NON MENTAL HEALTH DXS
IF +ICD<290!(+ICD>319.999999)
QUIT
+11 SET NARR=$GET(^AUTNPOV(+$GET(NIEN),0))
+12 IF '$LENGTH(NARR)
SET NARR=$PIECE($GET(^ICD9(IIEN,0)),U,3)
IF '$LENGTH(NARR)
SET NARR="<missing narrative>"
+13 SET NARR=NARR
+14 SET TOT=TOT+1
+15 SET VAR="mh"_TOT
+16 SET @TMP@(1,VAR)=DATE_" "_$EXTRACT(NARR,1,MAXNARR)_" ["_ICD_"]"
+17 QUIT
End DoDot:1
IF TOT>14
QUIT
+18 QUIT
+19 ;
ORLOG(DFN) ; EP-SURGERY HX BASED ON ANMC OR LOG
+1 ; FOR ANMC ONLY
+2 ; MUST HAVE A VALID DFN
IF '$DATA(^AZAORM(1,+$GET(DFN),1))
QUIT ""
+3 NEW DN,SN,PN,DATE,TOT,SURGEON,PNARR,ICD,DATE,X,Y,%,GBL,OUT,SIEN,STG
+4 SET GBL="^AZAORM(1,"_DFN_",1)"
SET TOT=0
SET DN=999999999
SET OUT=""
+5 FOR
SET DN=$ORDER(@GBL@(DN),-1)
IF 'DN
QUIT
Begin DoDot:1
+6 SET Y=$PIECE($GET(@GBL@(DN,0)),U)\1
IF 'Y
QUIT
+7 XECUTE ^DD("DD")
SET DATE=Y
+8 SET SN=0
+9 FOR
SET SN=$ORDER(@GBL@(DN,1,SN))
IF 'SN
QUIT
Begin DoDot:2
+10 SET SIEN=+$GET(@GBL@(DN,1,SN,0))
IF 'SIEN
QUIT
+11 SET %=U_"DIC("_16_")"
SET SURGEON=$PIECE($GET(@%@(SIEN,0)),U)
IF '$LENGTH(SURGEON)
QUIT
+12 SET PN=0
+13 FOR
SET PN=$ORDER(@GBL@(DN,1,SN,4,PN))
IF 'PN
QUIT
Begin DoDot:3
+14 SET STG=$GET(@GBL@(DN,1,SN,4,PN,0))
IF '$LENGTH(STG)
QUIT
+15 SET PNARR=$PIECE(STG,U)
IF '$LENGTH(PNARR)
QUIT
+16 SET %=$PIECE(STG,U,2)
+17 SET ICD=$PIECE($GET(^ICD0(+%,0)),U)
+18 SET TOT=TOT+1
+19 SET $PIECE(OUT,U,TOT)=(DATE_";"_PNARR_";"_ICD_";"_SURGEON)
+20 QUIT
End DoDot:3
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 QUIT OUT
+24 ;
SURG(DFN,DEFEF) ; EP - PRINT THE SURGICAL HX FROM THE OR LOG ON THE PCC+ FORM IN MERGE FIELDS u1-u15
+1 ; FOR ANMC ONLY
+2 ; MUST HAVE A VILD ER LOG DFN
IF '$DATA(^AZAORM(1,+$GET(DFN)))
QUIT
+3 NEW VAR,STG,X,Y,%,TOT,CASE,I,MAX
+4 SET STG=$$ORLOG(DFN)
IF '$LENGTH(STG)
QUIT
+5 SET MAX=$LENGTH(STG,U)
IF MAX>15
SET MAX=15
+6 FOR TOT=1:1:MAX
SET CASE=$PIECE(STG,U,TOT)
IF $LENGTH(CASE)
Begin DoDot:1
+7 ; PRINT DATE AND PROCEDURE NARRATIVE
SET X=$PIECE(CASE,";")_" "_$PIECE(CASE,";",2)
+8 ; PRINT THE ICD PROCEDURE CODE
IF $PIECE($GET(^VEN(7.41,DEFEF,5)),U,19)
SET X=X_" "_$PIECE(CASE,";",3)
+9 ; PRINT THE SURGEON
IF $PIECE($GET(^VEN(7.41,DEFEF,5)),U,20)
SET Y=$PIECE(CASE,";")
SET X=X_" DR. "_$EXTRACT($PIECE(Y,",",2))_". "_$PIECE(Y,",")
+10 SET VAR="u"_TOT
+11 SET @TMP@(1,VAR)=X
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
