AMHLECOC.m

AMHLECOC ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;

 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 ;

 W !!,"Current OPEN/ADMIT/CLOSE Dates:",!

 G:$G(^AMHPATR(AMHPAT,0))="" DIE

 W !?10,"CASE OPEN DATE:  " S Y=$P(^AMHPATR(AMHPAT,0),U,5) D DD^%DT W Y

 W !?10,"CASE ADMIT DATE:  " S Y=$P(^AMHPATR(AMHPAT,0),U,6) D DD^%DT W Y

 W !?10,"CASE CLOSED DATE:  " S Y=$P(^AMHPATR(AMHPAT,0),U,7) D DD^%DT W Y

 W !?10,"OUTCOME:  ",$$EXTSET^XBFUNC(9002011.55,.08,$P(^AMHPATR(AMHPAT,0),U,8))

 ;

 W !!

DIE ;

 I '$D(^AMHPATR(AMHPAT)) S DIC="^AMHPATR(",DIC(0)="L",DLAYGO=9002011.55,X="`"_AMHPAT D ^DIC D ^XBFMK I Y=-1 W !!,"FAILED TO ADD PATIENT TO BH PATIENT DATA FILE" G X

 K DIE,DR,DA,DIU,DIV L +^AMHPATR(AMHPAT):10 E  W !!,"Can't lock global" H 5 Q

 S DA=AMHPAT,DIE="^AMHPATR(",DR="[AMH UPDATE CASE OPEN/AMT/CLOSE" D ^DIE

 L -^AMHPATR(AMHPAT):10

 K DIE,DR,DA,DIU,DIV,DIW

 Q

X ;

 Q

AMHLECOC  ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;

 +1       ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010

 +2       ;

 +3        WRITE !!,"Current OPEN/ADMIT/CLOSE Dates:",!

 +4        IF $GET(^AMHPATR(AMHPAT,0))=""

               GOTO DIE

 +5        WRITE !?10,"CASE OPEN DATE:  "

           SET Y=$PIECE(^AMHPATR(AMHPAT,0),U,5)

           DO DD^%DT

           WRITE Y

 +6        WRITE !?10,"CASE ADMIT DATE:  "

           SET Y=$PIECE(^AMHPATR(AMHPAT,0),U,6)

           DO DD^%DT

           WRITE Y

 +7        WRITE !?10,"CASE CLOSED DATE:  "

           SET Y=$PIECE(^AMHPATR(AMHPAT,0),U,7)

           DO DD^%DT

           WRITE Y

 +8        WRITE !?10,"OUTCOME:  ",$$EXTSET^XBFUNC(9002011.55,.08,$PIECE(^AMHPATR(AMHPAT,0),U,8))

 +9       ;

 +10       WRITE !!

DIE       ;

 +1        IF '$DATA(^AMHPATR(AMHPAT))

               SET DIC="^AMHPATR("

               SET DIC(0)="L"

               SET DLAYGO=9002011.55

               SET X="`"_AMHPAT

               DO ^DIC

               DO ^XBFMK

               IF Y=-1

                   WRITE !!,"FAILED TO ADD PATIENT TO BH PATIENT DATA FILE"

                   GOTO X

 +2        KILL DIE,DR,DA,DIU,DIV

           LOCK +^AMHPATR(AMHPAT):10

          IF '$TEST

               WRITE !!,"Can't lock global"

               HANG 5

               QUIT 

 +3        SET DA=AMHPAT

           SET DIE="^AMHPATR("

           SET DR="[AMH UPDATE CASE OPEN/AMT/CLOSE"

           DO ^DIE

 +4        LOCK -^AMHPATR(AMHPAT):10

 +5        KILL DIE,DR,DA,DIU,DIV,DIW

 +6        QUIT 

X         ;

 +1        QUIT