- 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
