AMHEGRCP ; IHS/CMI/LAB - NEW PROGRAM ;
;;4.0;IHS BEHAVIORAL HEALTH;**2,4**;JUN 18, 2010;Build 28
;
;
;GET CPTS
;CALLED IN RECORD ADD
EP2 ;EP
S APCDOVRR=""
D EN^XBNEW("EP^AMHEGRCP","AMHR;AMHPAT;AMHLOC;AMHDATE;APCDOVRR;AMHGROUP")
Q
EP ;EP - ask for CPT and file each
I 'AMHR W !!,"NO RECORD DEFINED!!" D XIT Q
I '$D(^AMHREC(AMHR)) W !!,"NO RECORD!!" D XIT Q
S APCDOVRR=""
S AMHDONE="" F S AMHCPT="" D CPT Q:AMHDONE=1
D XIT
Q
CPT ;
S AMHDT=$P(AMHDATE,".")
W !!?3,"CPT's currently recorded on this visit:"
I '$D(^AMHRPROC("AD",AMHR)) S AMHC=0 W " None recorded" G FM12
;D EN^DDIOL("P","","!?3"),EN^DDIOL("Start Date","","?43"),EN^DDIOL("End Date","","?63")
D EN^DDIOL($$REPEAT^XLFSTR("-",75),"","!?3")
K AMHCM S X=0,AMHC=0 F S X=$O(^AMHRPROC("AD",AMHR,X)) Q:X'=+X D
.S AMHC=AMHC+1,AMHCM(AMHC)=X
.W !?2,AMHC,") ",$$VAL^XBDIQ1(9002011.04,X,.01),?14,$P($$CPT^ICPTCOD($$VAL^XBDIQ1(9002011.04,X,.01)),U,3)
.W !?10,"Quantity: ",$$VAL^XBDIQ1(9002011.04,X,.16)
.W !?10,"Modifier: ",$$VAL^XBDIQ1(9002011.04,X,.08)
.W !?10,"2nd Modifier: ",$$VAL^XBDIQ1(9002011.04,X,.09)
FM12 ;
D EN^DDIOL("","","!!")
K DIR
S DIR(0)="S^A:Add a CPT;E:Edit a CPT"_$S(AMHC:";D:Delete an Existing CPT",1:"")_";N:No Change"
S DIR("A")="Which action",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G FM13
I Y="N" S AMHDONE=1 G FM13
S Y="FM"_Y
D @Y
G CPT
FM13 ;
K Y
Q
;
FMD ;
D EN^DDIOL("","","!")
K DIR
S DIR(0)="N^1:"_AMHC_":0",DIR("A")="Delete Which One" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
K DIC,DA,DR
S DA=AMHCM(Y),DIK="^AMHRPROC(" D ^DIK K DA,DIK
Q
FMA ;
S DIC("A")="CPT for this patient: ",DIC("S")="D CPT^AMHUTIL1(Y,$S($G(AMHDATE):AMHDATE,$G(AMHR):$P($P($G(^AMHREC(AMHR,0)),U),"".""),1:DT))"
S DIC="^ICPT(",DIC(0)="AEMQ"
W ! D ^DIC
I Y=-1 D ^XBFMK Q
S AMHCPT=$P(Y,U,2),AMHCPTP=+Y
;call FILE^DICN to file this CPT
;
D ^XBFMK
K DD,D0,DO,DINUM,DIC,DA,DR S DIC(0)="EL",DIC="^AMHRPROC(",DLAYGO=9002011.04,DIADD=1,X=AMHCPTP
D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
I Y=-1 D ^XBFMK,XIT W !!,$C(7),$C(7),"Behavioral Health CPT failed!! Notify Site Manager." Q
S AMHRPROC=+Y,AMHCPTR=^AMHRPROC(AMHRPROC,0)
D ^XBFMK
S DIE("NO^")="",DA=AMHRPROC,DIE="^AMHRPROC(",DR=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.16//1;.08;.09" S DIE("NO^")="" D CALLDIE^AMHLEIN
S AMHCPTR=^AMHRPROC(AMHRPROC,0)
Q
;
XIT ;
K DIADD,DLAYGO
K AMHTX,AMHTY,AMHNARR,AMHLEPT,AMHNUM,AMHCPT,AMHCPTP,AMHCPTR,AMHRPROC,AMHDT,AMHLOOK
Q
FME ;
D EN^DDIOL("","","!")
K DIR
S DIR(0)="N^1:"_AMHC_":0",DIR("A")="Edit Which One" KILL DA D ^DIR KILL DIR
I $D(DIRUT) Q
K DIE,DA,DR
S DA=AMHCM(Y),DIE="^AMHRPROC("
S DR=".01;.16;.08;.09"
D ^DIE
K DIE,DA,DR
Q
AMHEGRCP ; IHS/CMI/LAB - NEW PROGRAM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**2,4**;JUN 18, 2010;Build 28
+2 ;
+3 ;
+4 ;GET CPTS
+5 ;CALLED IN RECORD ADD
EP2 ;EP
+1 SET APCDOVRR=""
+2 DO EN^XBNEW("EP^AMHEGRCP","AMHR;AMHPAT;AMHLOC;AMHDATE;APCDOVRR;AMHGROUP")
+3 QUIT
EP ;EP - ask for CPT and file each
+1 IF 'AMHR
WRITE !!,"NO RECORD DEFINED!!"
DO XIT
QUIT
+2 IF '$DATA(^AMHREC(AMHR))
WRITE !!,"NO RECORD!!"
DO XIT
QUIT
+3 SET APCDOVRR=""
+4 SET AMHDONE=""
FOR
SET AMHCPT=""
DO CPT
IF AMHDONE=1
QUIT
+5 DO XIT
+6 QUIT
CPT ;
+1 SET AMHDT=$PIECE(AMHDATE,".")
+2 WRITE !!?3,"CPT's currently recorded on this visit:"
+3 IF '$DATA(^AMHRPROC("AD",AMHR))
SET AMHC=0
WRITE " None recorded"
GOTO FM12
+4 ;D EN^DDIOL("P","","!?3"),EN^DDIOL("Start Date","","?43"),EN^DDIOL("End Date","","?63")
+5 DO EN^DDIOL($$REPEAT^XLFSTR("-",75),"","!?3")
+6 KILL AMHCM
SET X=0
SET AMHC=0
FOR
SET X=$ORDER(^AMHRPROC("AD",AMHR,X))
IF X'=+X
QUIT
Begin DoDot:1
+7 SET AMHC=AMHC+1
SET AMHCM(AMHC)=X
+8 WRITE !?2,AMHC,") ",$$VAL^XBDIQ1(9002011.04,X,.01),?14,$PIECE($$CPT^ICPTCOD($$VAL^XBDIQ1(9002011.04,X,.01)),U,3)
+9 WRITE !?10,"Quantity: ",$$VAL^XBDIQ1(9002011.04,X,.16)
+10 WRITE !?10,"Modifier: ",$$VAL^XBDIQ1(9002011.04,X,.08)
+11 WRITE !?10,"2nd Modifier: ",$$VAL^XBDIQ1(9002011.04,X,.09)
End DoDot:1
FM12 ;
+1 DO EN^DDIOL("","","!!")
+2 KILL DIR
+3 SET DIR(0)="S^A:Add a CPT;E:Edit a CPT"_$SELECT(AMHC:";D:Delete an Existing CPT",1:"")_";N:No Change"
+4 SET DIR("A")="Which action"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO FM13
+6 IF Y="N"
SET AMHDONE=1
GOTO FM13
+7 SET Y="FM"_Y
+8 DO @Y
+9 GOTO CPT
FM13 ;
+1 KILL Y
+2 QUIT
+3 ;
FMD ;
+1 DO EN^DDIOL("","","!")
+2 KILL DIR
+3 SET DIR(0)="N^1:"_AMHC_":0"
SET DIR("A")="Delete Which One"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 KILL DIC,DA,DR
+6 SET DA=AMHCM(Y)
SET DIK="^AMHRPROC("
DO ^DIK
KILL DA,DIK
+7 QUIT
FMA ;
+1 SET DIC("A")="CPT for this patient: "
SET DIC("S")="D CPT^AMHUTIL1(Y,$S($G(AMHDATE):AMHDATE,$G(AMHR):$P($P($G(^AMHREC(AMHR,0)),U),"".""),1:DT))"
+2 SET DIC="^ICPT("
SET DIC(0)="AEMQ"
+3 WRITE !
DO ^DIC
+4 IF Y=-1
DO ^XBFMK
QUIT
+5 SET AMHCPT=$PIECE(Y,U,2)
SET AMHCPTP=+Y
+6 ;call FILE^DICN to file this CPT
+7 ;
+8 DO ^XBFMK
+9 KILL DD,D0,DO,DINUM,DIC,DA,DR
SET DIC(0)="EL"
SET DIC="^AMHRPROC("
SET DLAYGO=9002011.04
SET DIADD=1
SET X=AMHCPTP
+10 DO FILE^DICN
KILL DIC,DR,DIE,DIADD,DLAYGO,X,D0
+11 IF Y=-1
DO ^XBFMK
DO XIT
WRITE !!,$CHAR(7),$CHAR(7),"Behavioral Health CPT failed!! Notify Site Manager."
QUIT
+12 SET AMHRPROC=+Y
SET AMHCPTR=^AMHRPROC(AMHRPROC,0)
+13 DO ^XBFMK
+14 SET DIE("NO^")=""
SET DA=AMHRPROC
SET DIE="^AMHRPROC("
SET DR=".02////"_$GET(AMHPAT)_";.03////"_AMHR_";.16//1;.08;.09"
SET DIE("NO^")=""
DO CALLDIE^AMHLEIN
+15 SET AMHCPTR=^AMHRPROC(AMHRPROC,0)
+16 QUIT
+17 ;
XIT ;
+1 KILL DIADD,DLAYGO
+2 KILL AMHTX,AMHTY,AMHNARR,AMHLEPT,AMHNUM,AMHCPT,AMHCPTP,AMHCPTR,AMHRPROC,AMHDT,AMHLOOK
+3 QUIT
FME ;
+1 DO EN^DDIOL("","","!")
+2 KILL DIR
+3 SET DIR(0)="N^1:"_AMHC_":0"
SET DIR("A")="Edit Which One"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
QUIT
+5 KILL DIE,DA,DR
+6 SET DA=AMHCM(Y)
SET DIE="^AMHRPROC("
+7 SET DR=".01;.16;.08;.09"
+8 DO ^DIE
+9 KILL DIE,DA,DR
+10 QUIT
