AMHEYC1 ; IHS/CMI/LAB - RECORD REVIEW PROCESS ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
;
;
;
;
START ;
S (AMHBT,AMHBTH)=$H,AMHJOB=$J,AMH("ERROR COUNT")=0,AMHO("RUN")="NEW"
D DATE,XIT
Q
;
DATE ; Run by encounter date
S X1=AMHBD,X2=-1 D C^%DTC S AMHSD=X
S AMHODAT=AMHSD_".9999" F S AMHODAT=$O(^AMHREC("AEX",AMHODAT)) Q:AMHODAT=""!((AMHODAT\1)>AMHED) D D1
Q
;
XIT ;
S AMHET=$H
D EOJ
Q
EOJ ;
Q
D1 ;
S (AMHR,AMHRCNT)=0 F S AMHR=$O(^AMHREC("AEX",AMHODAT,AMHR)) Q:AMHR'=+AMHR S AMHREC=^AMHREC(AMHR,0) D PROC
Q
PROC ;
K AMHE,AMHTX D RECORD
Q:AMHE=""
S AMH("ERROR COUNT")=AMH("ERROR COUNT")+1
S AMHE("ERR DFN")=$O(^AMHERR("B",AMHE,"")) I AMHE("ERR DFN")="" S AMHE("MSG")=AMHE_"-ERROR INFORMATION NOT IN ERROR FILE" G ERR
S AMHE("MSG")=AMHE_"-"_$P(^AMHERR(AMHE("ERR DFN"),0),U,2) S:$L(AMHE("MSG"))=5 AMHE("MSG")=AMHE("MSG")_"- ERROR INFORMATION NOT IN ERROR FILE" S AMHE("MSG")=$E(AMHE("MSG"),1,45)
ERR S ^XTMP("AMHEYC",AMHJOB,AMHBT,"ERRORS",AMHR)=AMHE("MSG")
Q
;
RECORD ;EP
S (AMHE,AMHTX)="" K AMHRTYPE
I '$D(^AMHREC(AMHR)) S AMHE="E026" Q
;
D S X=$P($P(AMHREC,U),".") I X="" S AMHE="E001" Q
;
PROG S X=$P(AMHREC,U,2) I X="" S AMHE="E003" Q
;
LOENC S X=$P(AMHREC,U,4) I X="" S AMHE="E004" Q
S X=$P(^AUTTLOC(X,0),U,10) I X=""!($L(X)'=6) S AMHE="E005" Q
COMM S AMHCOM=$P(AMHREC,U,5) I AMHCOM="" S AMHE="E006" Q
S X=$P(^AUTTCOM(AMHCOM,0),U,8) I X="" S AMHE="E007" Q
;
ACT S X=$P(AMHREC,U,6) I X="" S AMHE="E009" Q
I '$D(^AMHTACT(X)) S AMHE="E009" Q
S X=$P(^AMHTACT(X,0),U) I X="" S AMHE="E009" Q
;
CONT S X=$P(AMHREC,U,7) I X="" S AMHE="E010" Q
I '$D(^AMHTSET(X)) S AMHE="E010" Q
S X=$P(^AMHTSET(X,0),U,2) I X="" S AMHE="E010" Q
;
PROV ;get providers
I '$D(^AMHRPROV("AD",AMHR)) S AMHE="E022" Q
S X=0 F S X=$O(^AMHRPROV("AD",AMHR,X)) Q:X'=+X S Y=$P($G(^AMHRPROV(X,0)),U) I '$D(^VA(200,Y,0)) S AMHE="E023" Q
S AMHAFF=$$PPAFFL^AMHUTIL(AMHR,"I") I AMHAFF=""!(AMHAFF["?") S AMHE="E023" Q
S AMHDISC=$$PPCLSC^AMHUTIL(AMHR) I AMHDISC=""!(AMHDISC["?") S AMHE="E024" Q
S AMHINI=$$PPINI^AMHUTIL(AMHR) I AMHINI["?" S AMHE="E025" Q
S AMHRIEN=0,AMHC=1 F S AMHRIEN=$O(^AMHRPROV("AD",AMHR,AMHRIEN)) Q:AMHRIEN'=+AMHRIEN!(AMHE]"") I $P(^AMHRPROV(AMHRIEN,0),U,4)'="P" S AMHX=$P(^AMHRPROV(AMHRIEN,0),U) D
.S AMHAFF=$$PROVAFFL^XBFUNC1(AMHX,"I") I AMHAFF=""!(AMHAFF["?") S AMHE="E023" Q
.S AMHDISC=$$PROVCLSC^XBFUNC1(AMHX) I AMHDISC=""!(AMHDISC["?")!(AMHDISC["UNKNOWN") S AMHE="E024" Q
.S AMHINI=$$PROVINI^XBFUNC1(AMHX) I AMHINI=""!(AMHINI["?") S AMHE="E025" Q
Q:AMHE]""
POVS ;get problems first 4
I '$D(^AMHRPRO("AD",AMHR)) S AMHE="E021" Q
PATIENT ;
I $P(AMHREC,U,8)="" Q
S AMHPAT=$P(AMHREC,U,8)
S Y=AMHPAT D ^AUPNPAT
SEX ;
I AUPNSEX="" S AMHE="E014" Q
S X=AUPNSEX ;
DOB ;
I AUPNDOB="" S AMHE="E015" Q
S X=AUPNDOB ;
I '$D(^AUPNPAT(AMHPAT,11)) S AMHE="E016" Q
COMRES ;
S Y=0,AMHCOM="" F S Y=$O(^AUPNPAT(AMHPAT,51,Y)) Q:Y'=+Y S AMHCOM=Y
I AMHCOM="" S AMHE="E016" Q
S AMHCOM=$P(^AUPNPAT(AMHPAT,51,AMHCOM,0),U,3) I AMHCOM="" S AMHE="E017" Q
I '$D(^AUTTCOM(AMHCOM,0)) S AMHE="E017" Q
I AMHCOM]"" S X=$P(^AUTTCOM(AMHCOM,0),U,8) I X="" S AMHE="E017" Q
;
TRIBE ;
S X=$P(^AUPNPAT(AMHPAT,11),U,8) I X="" S AMHE="E018" Q
I $P(^AUTTTRI(X,0),U,4)="Y" S AMHE="E019" Q
S X=$P(^AUTTTRI(X,0),U,2) I X="" S AMHE="E020" Q
;
Q
AMHEYC1 ; IHS/CMI/LAB - RECORD REVIEW PROCESS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
+2 ;
+3 ;
+4 ;
+5 ;
START ;
+1 SET (AMHBT,AMHBTH)=$HOROLOG
SET AMHJOB=$JOB
SET AMH("ERROR COUNT")=0
SET AMHO("RUN")="NEW"
+2 DO DATE
DO XIT
+3 QUIT
+4 ;
DATE ; Run by encounter date
+1 SET X1=AMHBD
SET X2=-1
DO C^%DTC
SET AMHSD=X
+2 SET AMHODAT=AMHSD_".9999"
FOR
SET AMHODAT=$ORDER(^AMHREC("AEX",AMHODAT))
IF AMHODAT=""!((AMHODAT\1)>AMHED)
QUIT
DO D1
+3 QUIT
+4 ;
XIT ;
+1 SET AMHET=$HOROLOG
+2 DO EOJ
+3 QUIT
EOJ ;
+1 QUIT
D1 ;
+1 SET (AMHR,AMHRCNT)=0
FOR
SET AMHR=$ORDER(^AMHREC("AEX",AMHODAT,AMHR))
IF AMHR'=+AMHR
QUIT
SET AMHREC=^AMHREC(AMHR,0)
DO PROC
+2 QUIT
PROC ;
+1 KILL AMHE,AMHTX
DO RECORD
+2 IF AMHE=""
QUIT
+3 SET AMH("ERROR COUNT")=AMH("ERROR COUNT")+1
+4 SET AMHE("ERR DFN")=$ORDER(^AMHERR("B",AMHE,""))
IF AMHE("ERR DFN")=""
SET AMHE("MSG")=AMHE_"-ERROR INFORMATION NOT IN ERROR FILE"
GOTO ERR
+5 SET AMHE("MSG")=AMHE_"-"_$PIECE(^AMHERR(AMHE("ERR DFN"),0),U,2)
IF $LENGTH(AMHE("MSG"))=5
SET AMHE("MSG")=AMHE("MSG")_"- ERROR INFORMATION NOT IN ERROR FILE"
SET AMHE("MSG")=$EXTRACT(AMHE("MSG"),1,45)
ERR SET ^XTMP("AMHEYC",AMHJOB,AMHBT,"ERRORS",AMHR)=AMHE("MSG")
+1 QUIT
+2 ;
RECORD ;EP
+1 SET (AMHE,AMHTX)=""
KILL AMHRTYPE
+2 IF '$DATA(^AMHREC(AMHR))
SET AMHE="E026"
QUIT
+3 ;
D SET X=$PIECE($PIECE(AMHREC,U),".")
IF X=""
SET AMHE="E001"
QUIT
+1 ;
PROG SET X=$PIECE(AMHREC,U,2)
IF X=""
SET AMHE="E003"
QUIT
+1 ;
LOENC SET X=$PIECE(AMHREC,U,4)
IF X=""
SET AMHE="E004"
QUIT
+1 SET X=$PIECE(^AUTTLOC(X,0),U,10)
IF X=""!($LENGTH(X)'=6)
SET AMHE="E005"
QUIT
COMM SET AMHCOM=$PIECE(AMHREC,U,5)
IF AMHCOM=""
SET AMHE="E006"
QUIT
+1 SET X=$PIECE(^AUTTCOM(AMHCOM,0),U,8)
IF X=""
SET AMHE="E007"
QUIT
+2 ;
ACT SET X=$PIECE(AMHREC,U,6)
IF X=""
SET AMHE="E009"
QUIT
+1 IF '$DATA(^AMHTACT(X))
SET AMHE="E009"
QUIT
+2 SET X=$PIECE(^AMHTACT(X,0),U)
IF X=""
SET AMHE="E009"
QUIT
+3 ;
CONT SET X=$PIECE(AMHREC,U,7)
IF X=""
SET AMHE="E010"
QUIT
+1 IF '$DATA(^AMHTSET(X))
SET AMHE="E010"
QUIT
+2 SET X=$PIECE(^AMHTSET(X,0),U,2)
IF X=""
SET AMHE="E010"
QUIT
+3 ;
PROV ;get providers
+1 IF '$DATA(^AMHRPROV("AD",AMHR))
SET AMHE="E022"
QUIT
+2 SET X=0
FOR
SET X=$ORDER(^AMHRPROV("AD",AMHR,X))
IF X'=+X
QUIT
SET Y=$PIECE($GET(^AMHRPROV(X,0)),U)
IF '$DATA(^VA(200,Y,0))
SET AMHE="E023"
QUIT
+3 SET AMHAFF=$$PPAFFL^AMHUTIL(AMHR,"I")
IF AMHAFF=""!(AMHAFF["?")
SET AMHE="E023"
QUIT
+4 SET AMHDISC=$$PPCLSC^AMHUTIL(AMHR)
IF AMHDISC=""!(AMHDISC["?")
SET AMHE="E024"
QUIT
+5 SET AMHINI=$$PPINI^AMHUTIL(AMHR)
IF AMHINI["?"
SET AMHE="E025"
QUIT
+6 SET AMHRIEN=0
SET AMHC=1
FOR
SET AMHRIEN=$ORDER(^AMHRPROV("AD",AMHR,AMHRIEN))
IF AMHRIEN'=+AMHRIEN!(AMHE]"")
QUIT
IF $PIECE(^AMHRPROV(AMHRIEN,0),U,4)'="P"
SET AMHX=$PIECE(^AMHRPROV(AMHRIEN,0),U)
Begin DoDot:1
+7 SET AMHAFF=$$PROVAFFL^XBFUNC1(AMHX,"I")
IF AMHAFF=""!(AMHAFF["?")
SET AMHE="E023"
QUIT
+8 SET AMHDISC=$$PROVCLSC^XBFUNC1(AMHX)
IF AMHDISC=""!(AMHDISC["?")!(AMHDISC["UNKNOWN")
SET AMHE="E024"
QUIT
+9 SET AMHINI=$$PROVINI^XBFUNC1(AMHX)
IF AMHINI=""!(AMHINI["?")
SET AMHE="E025"
QUIT
End DoDot:1
+10 IF AMHE]""
QUIT
POVS ;get problems first 4
+1 IF '$DATA(^AMHRPRO("AD",AMHR))
SET AMHE="E021"
QUIT
PATIENT ;
+1 IF $PIECE(AMHREC,U,8)=""
QUIT
+2 SET AMHPAT=$PIECE(AMHREC,U,8)
+3 SET Y=AMHPAT
DO ^AUPNPAT
SEX ;
+1 IF AUPNSEX=""
SET AMHE="E014"
QUIT
+2 ;
SET X=AUPNSEX
DOB ;
+1 IF AUPNDOB=""
SET AMHE="E015"
QUIT
+2 ;
SET X=AUPNDOB
+3 IF '$DATA(^AUPNPAT(AMHPAT,11))
SET AMHE="E016"
QUIT
COMRES ;
+1 SET Y=0
SET AMHCOM=""
FOR
SET Y=$ORDER(^AUPNPAT(AMHPAT,51,Y))
IF Y'=+Y
QUIT
SET AMHCOM=Y
+2 IF AMHCOM=""
SET AMHE="E016"
QUIT
+3 SET AMHCOM=$PIECE(^AUPNPAT(AMHPAT,51,AMHCOM,0),U,3)
IF AMHCOM=""
SET AMHE="E017"
QUIT
+4 IF '$DATA(^AUTTCOM(AMHCOM,0))
SET AMHE="E017"
QUIT
+5 IF AMHCOM]""
SET X=$PIECE(^AUTTCOM(AMHCOM,0),U,8)
IF X=""
SET AMHE="E017"
QUIT
+6 ;
TRIBE ;
+1 SET X=$PIECE(^AUPNPAT(AMHPAT,11),U,8)
IF X=""
SET AMHE="E018"
QUIT
+2 IF $PIECE(^AUTTTRI(X,0),U,4)="Y"
SET AMHE="E019"
QUIT
+3 SET X=$PIECE(^AUTTTRI(X,0),U,2)
IF X=""
SET AMHE="E020"
QUIT
+4 ;
+5 QUIT
