- AMHLE3 ; IHS/CMI/LAB - DE CONT. ;
- ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
- ;
- ;
- PHX ;EP
- ;called from DIE
- D EN^XBNEW("EP^AMHLE3","AMHPAT;AUPN*")
- Q
- PR ;EP
- Q:'$G(AMHPAT)
- 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" Q
- S DA=AMHPAT,DDSFILE=9002011.55,DR="[AMH PATIENT RELATED DATA]" D ^DDS
- I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG Q
- Q
- EP ;EP
- Q:'$G(AMHPAT)
- ;DISPLAY IN DATE ORDER
- ;
- I '$D(^AMHPPHX("AC",AMHPAT)) W !!,"********** No Personal History currently on file for ",$P(^DPT(AMHPAT,0),U),".",!
- S AMHHEAD=" PERSONAL HISTORY FOR "_$P(^DPT(AMHPAT,0),U) D SUBHEAD
- S AMHX=0 F S AMHX=$O(^AMHPPHX("AC",AMHPAT,AMHX)) Q:AMHX'=+AMHX D
- .S AMHD=$P(^AMHPPHX(AMHX,0),U,3) D DATE
- .;W !,AMHD,?11,$E($P(^AMHTPHF($P(^AMHPPHX(AMHX,0),U),0),U),1,25)
- .W !,$E($P(^AMHTPHF($P(^AMHPPHX(AMHX,0),U),0),U),1,25)
- .Q
- ;call DIR to get the factor
- K DIR S DIR(0)="9002011.52,.01",DIR("A")="Enter PERSONAL HISTORY" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) W !!,"Bye..." D EOJ Q
- S AMHPHX=+Y
- I $D(^AMHPPHX("AA",AMHPAT,AMHPHX)) W !!,$P(^AMHTPHF(AMHPHX,0),U)," already recorded for this patient.",!,$C(7),"You may change it or delete it. To delete an entry, enter an '@'.",! D D EOJ Q
- .S DIE="^AMHPPHX(",DR=".01",DA=$O(^AMHPPHX("AA",AMHPAT,AMHPHX,0))
- .L +^AMHPPHX(DA,0):10 E W !!,"Can't lock global entry." Q
- .D ^DIE
- .L -^AMHPPHX:10
- .K DIE,DA,DR
- S DIC(0)="L",DIC="^AMHPPHX(",DLAYGO=9002011.52,DIADD=1,X="`"_AMHPHX K DD S DIC("DR")=".02////^S X=AMHPAT;.03////"_$S($G(AMHDATE)]"":$P(AMHDATE,"."),1:DT) D ^DIC
- I Y=-1 W !!,"Adding Personal History of ",$P(^AMHPPHX(AMHPHX,0),U)," failed.",!
- K Y
- D EOJ
- Q
- DATE ;
- S AMHD=$E(AMHD,4,5)_"/"_$E(AMHD,6,7)_"/"_$E(AMHD,2,3)
- Q
- ;
- PEF ;EP - called from AMHLEA - other
- S AMHR=%,AMHPAT=%1
- K AMHEFT
- ;W !! S DIR(0)="S^F:Full Encounter Form;S:Suppressed Encounter Form;B:Both a Suppressed & Full;T:2 copies of the Suppressed;E:2 copies of the Full"
- ;S DIR("A")="What type of form do you want to print"
- ;S DIR("B")=$S($P(^AMHSITE(DUZ(2),0),U,23)]"":$P(^AMHSITE(DUZ(2),0),U,23),1:"B") K DA D ^DIR K DIR
- D FORMDIR^AMHLEFP(AMHR)
- Q:$D(DIRUT)
- S AMHEFT=Y
- S AMHACTN=5
- S XBRC="COMP^AMHLEFP",XBRP="^AMHLEFP2",XBNS="AMH",XBRX="XIT^AMHLEFP"
- D ^XBDBQUE
- K %,%1
- Q
- EOJ ;EOJ CLEANUP
- K DIADD,DLAYGO
- D ^XBFMK
- K AMHS,AMHX,AMHD,AMHHEAD,AMHPHX
- Q
- SUBHEAD ;
- NEW L
- S AMHS="",L=(80-$L(AMHHEAD))/2,$P(AMHS,"*",L)="*"
- W !!,AMHS,AMHHEAD,AMHS
- Q
- AMHLE3 ; IHS/CMI/LAB - DE CONT. ;
- +1 ;;4.0;IHS BEHAVIORAL HEALTH;**1**;JUN 18, 2010;Build 8
- +2 ;
- +3 ;
- PHX ;EP
- +1 ;called from DIE
- +2 DO EN^XBNEW("EP^AMHLE3","AMHPAT;AUPN*")
- +3 QUIT
- PR ;EP
- +1 IF '$GET(AMHPAT)
- QUIT
- +2 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"
- QUIT
- +3 SET DA=AMHPAT
- SET DDSFILE=9002011.55
- SET DR="[AMH PATIENT RELATED DATA]"
- DO ^DDS
- +4 IF $DATA(DIMSG)
- WRITE !!,"ERROR IN SCREENMAN FORM!! ***NOTIFY PROGRAMMER***"
- SET AMHQUIT=1
- KILL DIMSG
- QUIT
- +5 QUIT
- EP ;EP
- +1 IF '$GET(AMHPAT)
- QUIT
- +2 ;DISPLAY IN DATE ORDER
- +3 ;
- +4 IF '$DATA(^AMHPPHX("AC",AMHPAT))
- WRITE !!,"********** No Personal History currently on file for ",$PIECE(^DPT(AMHPAT,0),U),".",!
- +5 SET AMHHEAD=" PERSONAL HISTORY FOR "_$PIECE(^DPT(AMHPAT,0),U)
- DO SUBHEAD
- +6 SET AMHX=0
- FOR
- SET AMHX=$ORDER(^AMHPPHX("AC",AMHPAT,AMHX))
- IF AMHX'=+AMHX
- QUIT
- Begin DoDot:1
- +7 SET AMHD=$PIECE(^AMHPPHX(AMHX,0),U,3)
- DO DATE
- +8 ;W !,AMHD,?11,$E($P(^AMHTPHF($P(^AMHPPHX(AMHX,0),U),0),U),1,25)
- +9 WRITE !,$EXTRACT($PIECE(^AMHTPHF($PIECE(^AMHPPHX(AMHX,0),U),0),U),1,25)
- +10 QUIT
- End DoDot:1
- +11 ;call DIR to get the factor
- +12 KILL DIR
- SET DIR(0)="9002011.52,.01"
- SET DIR("A")="Enter PERSONAL HISTORY"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +13 IF $DATA(DIRUT)
- WRITE !!,"Bye..."
- DO EOJ
- QUIT
- +14 SET AMHPHX=+Y
- +15 IF $DATA(^AMHPPHX("AA",AMHPAT,AMHPHX))
- WRITE !!,$PIECE(^AMHTPHF(AMHPHX,0),U)," already recorded for this patient.",!,$CHAR(7),"You may change it or delete it. To delete an entry, enter an '@'.",!
- Begin DoDot:1
- +16 SET DIE="^AMHPPHX("
- SET DR=".01"
- SET DA=$ORDER(^AMHPPHX("AA",AMHPAT,AMHPHX,0))
- +17 LOCK +^AMHPPHX(DA,0):10
- IF '$TEST
- WRITE !!,"Can't lock global entry."
- QUIT
- +18 DO ^DIE
- +19 LOCK -^AMHPPHX:10
- +20 KILL DIE,DA,DR
- End DoDot:1
- DO EOJ
- QUIT
- +21 SET DIC(0)="L"
- SET DIC="^AMHPPHX("
- SET DLAYGO=9002011.52
- SET DIADD=1
- SET X="`"_AMHPHX
- KILL DD
- SET DIC("DR")=".02////^S X=AMHPAT;.03////"_$SELECT($GET(AMHDATE)]"":$PIECE(AMHDATE,"."),1:DT)
- DO ^DIC
- +22 IF Y=-1
- WRITE !!,"Adding Personal History of ",$PIECE(^AMHPPHX(AMHPHX,0),U)," failed.",!
- +23 KILL Y
- +24 DO EOJ
- +25 QUIT
- DATE ;
- +1 SET AMHD=$EXTRACT(AMHD,4,5)_"/"_$EXTRACT(AMHD,6,7)_"/"_$EXTRACT(AMHD,2,3)
- +2 QUIT
- +3 ;
- PEF ;EP - called from AMHLEA - other
- +1 SET AMHR=%
- SET AMHPAT=%1
- +2 KILL AMHEFT
- +3 ;W !! S DIR(0)="S^F:Full Encounter Form;S:Suppressed Encounter Form;B:Both a Suppressed & Full;T:2 copies of the Suppressed;E:2 copies of the Full"
- +4 ;S DIR("A")="What type of form do you want to print"
- +5 ;S DIR("B")=$S($P(^AMHSITE(DUZ(2),0),U,23)]"":$P(^AMHSITE(DUZ(2),0),U,23),1:"B") K DA D ^DIR K DIR
- +6 DO FORMDIR^AMHLEFP(AMHR)
- +7 IF $DATA(DIRUT)
- QUIT
- +8 SET AMHEFT=Y
- +9 SET AMHACTN=5
- +10 SET XBRC="COMP^AMHLEFP"
- SET XBRP="^AMHLEFP2"
- SET XBNS="AMH"
- SET XBRX="XIT^AMHLEFP"
- +11 DO ^XBDBQUE
- +12 KILL %,%1
- +13 QUIT
- EOJ ;EOJ CLEANUP
- +1 KILL DIADD,DLAYGO
- +2 DO ^XBFMK
- +3 KILL AMHS,AMHX,AMHD,AMHHEAD,AMHPHX
- +4 QUIT
- SUBHEAD ;
- +1 NEW L
- +2 SET AMHS=""
- SET L=(80-$LENGTH(AMHHEAD))/2
- SET $PIECE(AMHS,"*",L)="*"
- +3 WRITE !!,AMHS,AMHHEAD,AMHS
- +4 QUIT
