AMHEGRCP.m

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