- 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
