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