- AMHLEE ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;
- ;;4.0;IHS BEHAVIORAL HEALTH;**1,2,4,8**;JUN 02, 2010;Build 7
- ;
- EDITR ;EP -protocol
- I AMHRCNT=0 W !,"There are no visits in the list to edit." D PAUSE^AMHLEA D XIT Q
- K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Edit Which Record" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) W !,"No record selected." G XIT
- S AMHR1=+Y I 'AMHR1 K VALMY,XQORNOD W !,"No record selected." G XIT
- S AMHR=^TMP("AMHVRECS",$J,"IDX",AMHR1,AMHR1) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- D FULL^VALM1
- I $P(^AMHREC(AMHR,0),U,34) W !!,"This is a group encounter. You must edit this group visit through the Group",!,"Form Data Entry menu option.",! D PAUSE^AMHLEA,XIT Q
- I $$EHR^AMHUTIL(AMHR) D EHRE^AMHEHR D PAUSE^AMHLEA,XIT Q
- DGSECE ;
- I '$P(^AMHREC(AMHR,0),U,8) G EDITR9
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- I '$G(AMHRESU(1)) G EDITR9
- I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE,PAUSE^AMHLEA,XIT Q
- D DISPDG^AMHLE
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to edit this record",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I 'Y D XIT Q
- K AMHRESU
- D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITR9 ;
- I $P($G(^AMHREC(AMHR,11)),U,12)]"",$O(^AMHREC(AMHR,31,0)) D
- .W !!,"The progress note has been electronically signed. You will not be able to edit the note.",!,"You will be able to edit the other visit items when you press enter to continue.",! D PAUSE^AMHLEA
- W:$D(IOF) @IOF W !,"You are editing the following record:",!!,VALMHDR(4),!,AMHDASH,! W ^TMP("AMHVRECS",$J,AMHR1,0),!!!
- D FULL^VALM1
- EDIT ;EP
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- S AMHVTYPE=$P(^AMHREC(AMHR,0),U,33)
- I AMHVTYPE="" S AMHVTYPE="R"
- S AMHACTN=2
- S DIADD=1,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR K DIADD
- EDIT1 ;
- I $G(AMHDET)="S" D
- .I $P($G(^AMHREC(AMHR,11)),U,12)]"",$O(^AMHREC(AMHR,31,0)) S DR="[AMHSV EDIT RECORD]"
- .I $P($G(^AMHREC(AMHR,11)),U,12)]"",'$O(^AMHREC(AMHR,31,0)) S DR="[AMH EDIT RECORD]"
- .I $P($G(^AMHREC(AMHR,11)),U,12)="" S DR=$S(AMHPAT:"[AMH EDIT RECORD]",1:"[AMH ADD NON-PAT RECORD]")
- .S DA=AMHR,DDSFILE=9002011 D ^DDS D
- ..I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ** NOTIFY PROGRAMMER **" S AMHQUIT=1 K DIMSG Q
- ..I $P(^AMHREC(AMHR,0),U,22)'="A" S DA=AMHR,DIE="^AMHREC(",DR=".22///M" D ^DIE K DA,DIE,DR
- ..I $D(^AMHRCDST("B",AMHR)) D CDST^AMHLEA
- ..I $D(^AMHREC(AMHR,0)),$P(^AMHREC(AMHR,0),U,33)="S"!($P(^AMHREC(AMHR,0),U,33)="U") S AMHPAT=$P(^AMHREC(AMHR,0),U,8) I AMHPAT D EP1^AMHLESAN(AMHPAT,AMHR)
- S DIE="^AMHREC(",DA=AMHR,DR="1117////"_$$HL^AMHUTIL2($$VALI^XBDIQ1(9002011,AMHR,.02)) D ^DIE K DIE,DA,DR ;IHS/CMI/LAB PATCH 8 HOSP LOC
- D CHECK^AMHLEA
- I $P(^AMHREC(AMHR,0),U,8)]"" D REGULAR^AMHLEP2
- I $P(^AMHREC(AMHR,0),U,8)]"" D SUIC^AMHLEA,OTHER^AMHLEA
- I AMHZED=1 G EDIT1
- D PCCLINK^AMHLEA
- D:'$G(AMHPATCE) XIT
- Q
- EDITSP ;EP
- I AMHRCNT=0 W !,"There are no visits in the list to edit." D PAUSE^AMHLEA D XIT Q
- K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Edit Which Record" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) W !,"No record selected." G XIT
- S AMHR1=+Y I 'AMHR1 K VALMY,XQORNOD W !,"No record selected." G XIT
- S AMHR=^TMP("AMHVRECS",$J,"IDX",AMHR1,AMHR1) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- D FULL^VALM1
- I $$EHR^AMHUTIL(AMHR) D EHRE^AMHEHR D PAUSE^AMHLEA,XIT Q
- I $P(^AMHREC(AMHR,0),U,34) W !!,"This is a group encounter. You must edit this group visit through the Group",!,"Form Data Entry menu option.",! D PAUSE^AMHLEA,XIT Q
- I $P($G(^AMHREC(AMHR,11)),U,12)]"",$O(^AMHREC(AMHR,31,0)) W !!,"You cannot edit this note, it has been electronically signed." D PAUSE^AMHLEA,XIT Q
- DGSECES ;
- I '$P(^AMHREC(AMHR,0),U,8) G EDITSP9
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- I '$G(AMHRESU(1)) G EDITSP9
- I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE,PAUSE^AMHLEA,XIT Q
- D DISPDG^AMHLE
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to edit the SOAP note",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I 'Y D XIT Q
- K AMHRESU
- D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITSP9 ;
- W:$D(IOF) @IOF W !,"You are editing the following record:",!!,VALMHDR(4),!,AMHDASH,! W ^TMP("AMHVRECS",$J,AMHR1,0),!!!
- D FULL^VALM1
- EDITSP1 ;
- I 'AMHPAT W !!,$C(7),$C(7),"This is not a patient visit!!" H 5 D XIT Q
- S AMHACTN=2
- S DA=AMHR,DR="[AMH EDIT SOAP/CC]",DIE="^AMHREC(" D CALLDIE^AMHLEIN
- D OTHER^AMHLEA
- D PCCLINK^AMHLEA
- D XIT
- Q
- EDITEHRR ;EP - protocol
- I AMHRCNT=0 W !,"There are no visits in the list to edit." D PAUSE^AMHLEA D XIT Q
- K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Edit Which Record" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) W !,"No record selected." G XIT
- S AMHR1=+Y I 'AMHR1 K VALMY,XQORNOD W !,"No record selected." G XIT
- S AMHR=^TMP("AMHVRECS",$J,"IDX",AMHR1,AMHR1) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- D FULL^VALM1
- I '$P($G(^AMHREC(AMHR,11)),U,10) W !!,"This visit was NOT created through EHR, please edit this visit with Edit Visit.",! D PAUSE^AMHLEA,XIT Q
- DGSECEH ;
- I '$P(^AMHREC(AMHR,0),U,8) G EDITH9
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- I '$G(AMHRESU(1)) G EDITH9
- I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE,PAUSE^AMHLEA,XIT Q
- D DISPDG^AMHLE
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to edit this record",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I 'Y D XIT Q
- K AMHRESU
- D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITH9 ;
- W:$D(IOF) @IOF W !,"You are editing the following record:",!!,VALMHDR(4),!,AMHDASH,! W ^TMP("AMHVRECS",$J,AMHR1,0),!!!
- D FULL^VALM1
- EDITEHR ;EP
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- S AMHVTYPE=$P(^AMHREC(AMHR,0),U,33)
- I AMHVTYPE="" S AMHVTYPE="R"
- S AMHACTN=2
- S DIADD=1,DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR K DIADD
- S DR=$S($$DSMCS^AMHUTIL1(DUZ(2),$P($P(^AMHREC(AMHR,0),U),"."))=4:"[AMH EHR EDIT RECORD]",1:"[AMHEH EHR EDIT RECORD"),DA=AMHR,DDSFILE=9002011 D ^DDS D
- .I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!! ** NOTIFY PROGRAMMER **" S AMHQUIT=1 K DIMSG Q
- I $P(^AMHREC(AMHR,0),U,8)]"" D REGULAR^AMHLEP2
- I $P(^AMHREC(AMHR,0),U,8)]"" D SUIC^AMHLEA,OTHER^AMHLEA
- S AMHERROR=0 D RECCHECK^AMHLE2 I AMHERROR D PAUSE^AMHLEA
- D:'$G(AMHPATCE) XIT
- Q
- SW ;EP -dates
- S DIR(0)="D^::EP",DIR("A")="Enter Date" KILL DA D ^DIR KILL DIR
- Q:$D(DIRUT)
- S AMHDATE=Y
- D FULL^VALM1
- D XIT
- Q
- DELETE ;EP-delete
- I AMHRCNT=0 W !,"There are no visits in the list to delete." D PAUSE^AMHLEA D XIT Q
- K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Delete Which Record" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) W !,"No record selected." G XIT
- S AMHR1=+Y I 'AMHR1 K VALMY,XQORNOD W !,"No record selected." G XIT
- S AMHR=^TMP("AMHVRECS",$J,"IDX",AMHR1,AMHR1) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- D FULL^VALM1
- DEL ;EP
- I $P($G(^AMHREC(AMHR,11)),U,12)]"",'$D(^XUSEC("AMHZ DELETE SIGNED NOTE",DUZ)),$O(^AMHREC(AMHR,31,0)) D Q
- .W !!,"You cannot delete this record, the note has been electronically signed.",!,"Please see your supervisor or program manager." D PAUSE^AMHLEA,XIT Q
- I '$D(^XUSEC("AMHZ DELETE RECORD",DUZ)),'$D(^XUSEC("AMHZ DELETE SIGNED NOTE",DUZ)) W !!,"You do not have the security access to delete a Visit.",!,"Please see your supervisor or program manager.",! D PAUSE^AMHLEA,XIT Q
- I $$EHR^AMHUTIL(AMHR) D EHRE^AMHEHR D PAUSE^AMHLEA,XIT Q
- DGSECD ;
- I '$P(^AMHREC(AMHR,0),U,8) G EDITD9
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- I '$G(AMHRESU(1)) G EDITD9
- I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE,PAUSE^AMHLEA,XIT Q
- D DISPDG^AMHLE
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to delete this record",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I 'Y D XIT Q
- K AMHRESU
- D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITD9 ;
- S AMHACTN=4
- I '$G(AMHGRPDE) D I 'Y!($D(DIRUT)) Q
- .D EN^AMHRDSP
- .W !! S DIR(0)="Y",DIR("A")="Are you sure you want to DELETE this record",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- .Q:$D(DIRUT)
- .Q:'Y
- D DEL^AMHLEA
- S AMHACTN=4 D PCCLINK^AMHLEA
- I '$D(AMHPATCE),'$G(AMHGRPDE) D XIT
- Q
- PRINT ;EP
- I AMHRCNT=0 W !,"There are no visits in the list to print." D PAUSE^AMHLEA D XIT Q
- K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Print Which Record" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) W !,"No record selected." G XIT
- S AMHR1=+Y I 'AMHR1 K VALMY,XQORNOD W !,"No record selected." G XIT
- S AMHR=^TMP("AMHVRECS",$J,"IDX",AMHR1,AMHR1) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- D FULL^VALM1
- DGSECP ;
- I '$P(^AMHREC(AMHR,0),U,8) G EDITP9
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- I '$G(AMHRESU(1)) G EDITP9
- I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE,PAUSE^AMHLEA,XIT Q
- D DISPDG^AMHLE
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to print this encounter form",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I 'Y D XIT Q
- K AMHRESU
- D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITP9 ;
- K AMHEFT
- D FORMDIR^AMHLEFP(AMHR)
- Q:$D(DIRUT)
- S AMHEFT=Y
- D FULL^VALM1
- S AMHACTN=5
- S XBRC="COMP^AMHLEFP",XBRP="^AMHLEFP2",XBNS="AMH",XBRX="XIT^AMHLEFP"
- D ^XBDBQUE
- D XIT
- Q
- DISPLAY ;EP
- I AMHRCNT=0 W !,"There are no visits to display." D PAUSE^AMHLEA D XIT Q
- K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Display Which Record" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) W !,"No record selected." G XIT
- S AMHR1=+Y I 'AMHR1 K VALMY,XQORNOD W !,"No record selected." G XIT
- S AMHR=^TMP("AMHVRECS",$J,"IDX",AMHR1,AMHR1) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- D FULL^VALM1
- DGSECDS ;
- I '$P(^AMHREC(AMHR,0),U,8) G EDITDS9
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- I '$G(AMHRESU(1)) G EDITDS9
- I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE,PAUSE^AMHLEA,XIT Q
- D DISPDG^AMHLE
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to display this record",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I 'Y D XIT Q
- K AMHRESU
- D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITDS9 ;
- DISP ;
- S AMHACTN=5
- D ^AMHDVD
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D OTHER^AMHLEA
- D XIT
- Q
- APPT ;
- D FULL^VALM1
- S AMHACTN=6
- D GETPAT^AMHLEA
- I 'AMHPAT W !,"NO Patient selected!",! D PAUSE^AMHLEA D XIT Q
- D APPT^AMHVRL2(AMHPAT)
- D PAUSE^AMHLEA
- D XIT
- Q
- HS ;EP - Display PP
- D FULL^VALM1
- S AMHACTN=6
- D GETPAT^AMHLEA
- I 'AMHPAT W !,"NO Patient selected!",! D PAUSE^AMHLEA D XIT Q
- D ^AMHDPP
- D PAUSE^AMHLEA
- D XIT
- Q
- ID ;EP
- D FULL^VALM1
- D GETPAT^AMHLEA
- I 'AMHPAT W !,"NO Patient selected!",! D PAUSE^AMHLEA D XIT Q
- D EP^AMHLEIVP(AMHPAT)
- D PAUSE^AMHLEA
- D XIT
- Q
- OI ;
- D FULL^VALM1
- S AMHACTN=6
- D GETPAT^AMHLEA
- I 'AMHPAT W !,"NO Patient selected!",! D PAUSE^AMHLEA D XIT Q
- D 1^AMHLEA
- D PAUSE^AMHLEA
- D XIT
- Q
- SR ;EP
- D FULL^VALM1
- D GETPAT^AMHLEA
- I 'AMHPAT W !,"NO Patient selected!",! D PAUSE^AMHLEA D XIT Q
- D EP^AMHPST(AMHPAT)
- D PAUSE^AMHLEA
- D XIT
- Q
- LAB ;
- D FULL^VALM1
- S AMHACTN=6
- D GETPAT^AMHLEA
- I 'AMHPAT W !,"NO Patient selected!",! D PAUSE^AMHLEA D XIT Q
- S DFN=AMHPAT,ORVP=AMHPAT_";DPT(" D OR^LRRP2 K DFN
- D PAUSE^AMHLEA
- D XIT
- Q
- TIUN ;EP
- I AMHRCNT=0 W !,"There are no visits in the list to display." D PAUSE^AMHLEA D XIT Q
- K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Display Note for Which Record" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) W !,"No record selected." G XIT
- S AMHR1=+Y I 'AMHR1 K VALMY,XQORNOD W !,"No record selected." G XIT
- S AMHR=^TMP("AMHVRECS",$J,"IDX",AMHR1,AMHR1) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I '$O(^AMHREC(AMHR,54,0)) W !,"There is no TIU Note associated with that visit." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- D FULL^VALM1
- DGSECT ;
- I '$P(^AMHREC(AMHR,0),U,8) G EDITT9
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- I '$G(AMHRESU(1)) G EDITT9
- I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE,PAUSE^AMHLEA,XIT Q
- D DISPDG^AMHLE
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to display the TIU note",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I 'Y D XIT Q
- K AMHRESU
- D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITT9 ;
- TIUN1 ;
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D TIU^AMHEHR
- D XIT
- Q
- ESIG ;EP - PROTOCOL
- NEW AMHXX,AMHR,AMHR1
- I AMHRCNT=0 W !,"There are no visits in the list to sign." D PAUSE^AMHLEA D XIT Q
- K DIR S DIR(0)="N^1:"_AMHRCNT_":0",DIR("A")="Sign Which Record" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) W !,"No record selected." G XIT
- S AMHR1=+Y I 'AMHR1 K VALMY,XQORNOD W !,"No record selected." G XIT
- S AMHR=^TMP("AMHVRECS",$J,"IDX",AMHR1,AMHR1) I 'AMHR K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I '$D(^AMHREC(AMHR,0)) W !,"Not a valid BH RECORD." K AMHRDEL,AMHR D PAUSE^AMHLEA D XIT Q
- I $P(^AMHREC(AMHR,0),U,34) W !!,"This is a group encounter. You must sign this note through the Group",!,"Form Data Entry menu option.",! D PAUSE^AMHLEA,XIT Q
- D FULL^VALM1
- DGSECS ;
- I '$P(^AMHREC(AMHR,0),U,8) G EDITS9
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- I '$G(AMHRESU(1)) G EDITS9
- I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE,PAUSE^AMHLEA,XIT Q
- D DISPDG^AMHLE
- W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to sign this note",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I 'Y D XIT Q
- K AMHRESU
- D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITS9 ;
- S AMHXX=$$ESIG^AMHESIG(AMHR)
- I 'AMHXX W !!,$P(AMHXX,U,3),! D PAUSE^AMHLEA I '$P(AMHXX,U,4) D XIT Q
- ESIGD ;
- S AMHACTN=5
- D ^AMHDVD
- S AMHPAT=$P(^AMHREC(AMHR,0),U,8)
- ESIGE ;
- W !!
- S DIR(0)="Y",DIR("A")="Do you wish to edit this record/note",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) D XIT Q
- I 'Y D ESIG9 Q
- D EDIT
- D XIT
- Q
- ESIG9 ;
- D OTHER^AMHLEA
- S AMHACTN=1
- D PCCLINK^AMHLEA
- D XIT
- Q
- XIT ;EP
- S VALMBCK="R"
- D TERM^VALM0
- D GATHER^AMHLEL
- S VALMCNT=AMHRCNT
- D HDR^AMHLE
- EOJ K AMHR,AMHTYPE,AMHR0,AMHERROR,AMHC,AMHRPOV,AMHX,AMHSHIGH,AMHOTH,AMHOKAY,AMHNONE,AMHACTN,AMHLOC,AMHPAT,DA,DIE,DIRUT,DUOUT,DIC,D0,AMHVDLT,AMHR1,DFN
- K AMHTYPE,AMHECLN,AMHSD,AMHVISIT,AMHRESU
- D KILL^AUPNPAT
- K DFN,AGE,SSN
- K DGXFRO,DGB
- Q
- AMHLEE ; IHS/CMI/LAB - MENTAL HLTH ROUTINE ;
- +1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,2,4,8**;JUN 02, 2010;Build 7
- +2 ;
- EDITR ;EP -protocol
- +1 IF AMHRCNT=0
- WRITE !,"There are no visits in the list to edit."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +2 KILL DIR
- SET DIR(0)="N^1:"_AMHRCNT_":0"
- SET DIR("A")="Edit Which Record"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- WRITE !,"No record selected."
- GOTO XIT
- +4 SET AMHR1=+Y
- IF 'AMHR1
- KILL VALMY,XQORNOD
- WRITE !,"No record selected."
- GOTO XIT
- +5 SET AMHR=^TMP("AMHVRECS",$JOB,"IDX",AMHR1,AMHR1)
- IF 'AMHR
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 IF '$DATA(^AMHREC(AMHR,0))
- WRITE !,"Not a valid BH RECORD."
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +7 DO FULL^VALM1
- +8 IF $PIECE(^AMHREC(AMHR,0),U,34)
- WRITE !!,"This is a group encounter. You must edit this group visit through the Group",!,"Form Data Entry menu option.",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +9 IF $$EHR^AMHUTIL(AMHR)
- DO EHRE^AMHEHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- DGSECE ;
- +1 IF '$PIECE(^AMHREC(AMHR,0),U,8)
- GOTO EDITR9
- +2 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +3 DO PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- +4 IF '$GET(AMHRESU(1))
- GOTO EDITR9
- +5 IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)
- DO DISPDG^AMHLE
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 DO DISPDG^AMHLE
- +7 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue to edit this record"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF 'Y
- DO XIT
- QUIT
- +9 KILL AMHRESU
- +10 DO NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITR9 ;
- +1 IF $PIECE($GET(^AMHREC(AMHR,11)),U,12)]""
- IF $ORDER(^AMHREC(AMHR,31,0))
- Begin DoDot:1
- +2 WRITE !!,"The progress note has been electronically signed. You will not be able to edit the note.",!,"You will be able to edit the other visit items when you press enter to continue.",!
- DO PAUSE^AMHLEA
- End DoDot:1
- +3 IF $DATA(IOF)
- WRITE @IOF
- WRITE !,"You are editing the following record:",!!,VALMHDR(4),!,AMHDASH,!
- WRITE ^TMP("AMHVRECS",$JOB,AMHR1,0),!!!
- +4 DO FULL^VALM1
- EDIT ;EP
- +1 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +2 SET AMHVTYPE=$PIECE(^AMHREC(AMHR,0),U,33)
- +3 IF AMHVTYPE=""
- SET AMHVTYPE="R"
- +4 SET AMHACTN=2
- +5 SET DIADD=1
- SET DIE="^AMHREC("
- SET DA=AMHR
- SET DR="5100///NOW"
- SET DR(2,9002011.5101)=".02////^S X=DUZ"
- DO ^DIE
- KILL DIE,DA,DR
- KILL DIADD
- EDIT1 ;
- +1 IF $GET(AMHDET)="S"
- Begin DoDot:1
- +2 IF $PIECE($GET(^AMHREC(AMHR,11)),U,12)]""
- IF $ORDER(^AMHREC(AMHR,31,0))
- SET DR="[AMHSV EDIT RECORD]"
- +3 IF $PIECE($GET(^AMHREC(AMHR,11)),U,12)]""
- IF '$ORDER(^AMHREC(AMHR,31,0))
- SET DR="[AMH EDIT RECORD]"
- +4 IF $PIECE($GET(^AMHREC(AMHR,11)),U,12)=""
- SET DR=$SELECT(AMHPAT:"[AMH EDIT RECORD]",1:"[AMH ADD NON-PAT RECORD]")
- +5 SET DA=AMHR
- SET DDSFILE=9002011
- DO ^DDS
- Begin DoDot:2
- +6 IF $DATA(DIMSG)
- WRITE !!,"ERROR IN SCREENMAN FORM!! ** NOTIFY PROGRAMMER **"
- SET AMHQUIT=1
- KILL DIMSG
- QUIT
- +7 IF $PIECE(^AMHREC(AMHR,0),U,22)'="A"
- SET DA=AMHR
- SET DIE="^AMHREC("
- SET DR=".22///M"
- DO ^DIE
- KILL DA,DIE,DR
- +8 IF $DATA(^AMHRCDST("B",AMHR))
- DO CDST^AMHLEA
- +9 IF $DATA(^AMHREC(AMHR,0))
- IF $PIECE(^AMHREC(AMHR,0),U,33)="S"!($PIECE(^AMHREC(AMHR,0),U,33)="U")
- SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- IF AMHPAT
- DO EP1^AMHLESAN(AMHPAT,AMHR)
- End DoDot:2
- End DoDot:1
- +10 ;IHS/CMI/LAB PATCH 8 HOSP LOC
- SET DIE="^AMHREC("
- SET DA=AMHR
- SET DR="1117////"_$$HL^AMHUTIL2($$VALI^XBDIQ1(9002011,AMHR,.02))
- DO ^DIE
- KILL DIE,DA,DR
- +11 DO CHECK^AMHLEA
- +12 IF $PIECE(^AMHREC(AMHR,0),U,8)]""
- DO REGULAR^AMHLEP2
- +13 IF $PIECE(^AMHREC(AMHR,0),U,8)]""
- DO SUIC^AMHLEA
- DO OTHER^AMHLEA
- +14 IF AMHZED=1
- GOTO EDIT1
- +15 DO PCCLINK^AMHLEA
- +16 IF '$GET(AMHPATCE)
- DO XIT
- +17 QUIT
- EDITSP ;EP
- +1 IF AMHRCNT=0
- WRITE !,"There are no visits in the list to edit."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +2 KILL DIR
- SET DIR(0)="N^1:"_AMHRCNT_":0"
- SET DIR("A")="Edit Which Record"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- WRITE !,"No record selected."
- GOTO XIT
- +4 SET AMHR1=+Y
- IF 'AMHR1
- KILL VALMY,XQORNOD
- WRITE !,"No record selected."
- GOTO XIT
- +5 SET AMHR=^TMP("AMHVRECS",$JOB,"IDX",AMHR1,AMHR1)
- IF 'AMHR
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 IF '$DATA(^AMHREC(AMHR,0))
- WRITE !,"Not a valid BH RECORD."
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +7 DO FULL^VALM1
- +8 IF $$EHR^AMHUTIL(AMHR)
- DO EHRE^AMHEHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +9 IF $PIECE(^AMHREC(AMHR,0),U,34)
- WRITE !!,"This is a group encounter. You must edit this group visit through the Group",!,"Form Data Entry menu option.",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +10 IF $PIECE($GET(^AMHREC(AMHR,11)),U,12)]""
- IF $ORDER(^AMHREC(AMHR,31,0))
- WRITE !!,"You cannot edit this note, it has been electronically signed."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- DGSECES ;
- +1 IF '$PIECE(^AMHREC(AMHR,0),U,8)
- GOTO EDITSP9
- +2 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +3 DO PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- +4 IF '$GET(AMHRESU(1))
- GOTO EDITSP9
- +5 IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)
- DO DISPDG^AMHLE
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 DO DISPDG^AMHLE
- +7 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue to edit the SOAP note"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF 'Y
- DO XIT
- QUIT
- +9 KILL AMHRESU
- +10 DO NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITSP9 ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- WRITE !,"You are editing the following record:",!!,VALMHDR(4),!,AMHDASH,!
- WRITE ^TMP("AMHVRECS",$JOB,AMHR1,0),!!!
- +2 DO FULL^VALM1
- EDITSP1 ;
- +1 IF 'AMHPAT
- WRITE !!,$CHAR(7),$CHAR(7),"This is not a patient visit!!"
- HANG 5
- DO XIT
- QUIT
- +2 SET AMHACTN=2
- +3 SET DA=AMHR
- SET DR="[AMH EDIT SOAP/CC]"
- SET DIE="^AMHREC("
- DO CALLDIE^AMHLEIN
- +4 DO OTHER^AMHLEA
- +5 DO PCCLINK^AMHLEA
- +6 DO XIT
- +7 QUIT
- EDITEHRR ;EP - protocol
- +1 IF AMHRCNT=0
- WRITE !,"There are no visits in the list to edit."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +2 KILL DIR
- SET DIR(0)="N^1:"_AMHRCNT_":0"
- SET DIR("A")="Edit Which Record"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- WRITE !,"No record selected."
- GOTO XIT
- +4 SET AMHR1=+Y
- IF 'AMHR1
- KILL VALMY,XQORNOD
- WRITE !,"No record selected."
- GOTO XIT
- +5 SET AMHR=^TMP("AMHVRECS",$JOB,"IDX",AMHR1,AMHR1)
- IF 'AMHR
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 IF '$DATA(^AMHREC(AMHR,0))
- WRITE !,"Not a valid BH RECORD."
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +7 DO FULL^VALM1
- +8 IF '$PIECE($GET(^AMHREC(AMHR,11)),U,10)
- WRITE !!,"This visit was NOT created through EHR, please edit this visit with Edit Visit.",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- DGSECEH ;
- +1 IF '$PIECE(^AMHREC(AMHR,0),U,8)
- GOTO EDITH9
- +2 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +3 DO PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- +4 IF '$GET(AMHRESU(1))
- GOTO EDITH9
- +5 IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)
- DO DISPDG^AMHLE
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 DO DISPDG^AMHLE
- +7 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue to edit this record"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF 'Y
- DO XIT
- QUIT
- +9 KILL AMHRESU
- +10 DO NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITH9 ;
- +1 IF $DATA(IOF)
- WRITE @IOF
- WRITE !,"You are editing the following record:",!!,VALMHDR(4),!,AMHDASH,!
- WRITE ^TMP("AMHVRECS",$JOB,AMHR1,0),!!!
- +2 DO FULL^VALM1
- EDITEHR ;EP
- +1 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +2 SET AMHVTYPE=$PIECE(^AMHREC(AMHR,0),U,33)
- +3 IF AMHVTYPE=""
- SET AMHVTYPE="R"
- +4 SET AMHACTN=2
- +5 SET DIADD=1
- SET DIE="^AMHREC("
- SET DA=AMHR
- SET DR="5100///NOW"
- SET DR(2,9002011.5101)=".02////^S X=DUZ"
- DO ^DIE
- KILL DIE,DA,DR
- KILL DIADD
- +6 SET DR=$SELECT($$DSMCS^AMHUTIL1(DUZ(2),$PIECE($PIECE(^AMHREC(AMHR,0),U),"."))=4:"[AMH EHR EDIT RECORD]",1:"[AMHEH EHR EDIT RECORD")
- SET DA=AMHR
- SET DDSFILE=9002011
- DO ^DDS
- Begin DoDot:1
- +7 IF $DATA(DIMSG)
- WRITE !!,"ERROR IN SCREENMAN FORM!! ** NOTIFY PROGRAMMER **"
- SET AMHQUIT=1
- KILL DIMSG
- QUIT
- End DoDot:1
- +8 IF $PIECE(^AMHREC(AMHR,0),U,8)]""
- DO REGULAR^AMHLEP2
- +9 IF $PIECE(^AMHREC(AMHR,0),U,8)]""
- DO SUIC^AMHLEA
- DO OTHER^AMHLEA
- +10 SET AMHERROR=0
- DO RECCHECK^AMHLE2
- IF AMHERROR
- DO PAUSE^AMHLEA
- +11 IF '$GET(AMHPATCE)
- DO XIT
- +12 QUIT
- SW ;EP -dates
- +1 SET DIR(0)="D^::EP"
- SET DIR("A")="Enter Date"
- KILL DA
- DO ^DIR
- KILL DIR
- +2 IF $DATA(DIRUT)
- QUIT
- +3 SET AMHDATE=Y
- +4 DO FULL^VALM1
- +5 DO XIT
- +6 QUIT
- DELETE ;EP-delete
- +1 IF AMHRCNT=0
- WRITE !,"There are no visits in the list to delete."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +2 KILL DIR
- SET DIR(0)="N^1:"_AMHRCNT_":0"
- SET DIR("A")="Delete Which Record"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- WRITE !,"No record selected."
- GOTO XIT
- +4 SET AMHR1=+Y
- IF 'AMHR1
- KILL VALMY,XQORNOD
- WRITE !,"No record selected."
- GOTO XIT
- +5 SET AMHR=^TMP("AMHVRECS",$JOB,"IDX",AMHR1,AMHR1)
- IF 'AMHR
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 IF '$DATA(^AMHREC(AMHR,0))
- WRITE !,"Not a valid BH RECORD."
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +7 DO FULL^VALM1
- DEL ;EP
- +1 IF $PIECE($GET(^AMHREC(AMHR,11)),U,12)]""
- IF '$DATA(^XUSEC("AMHZ DELETE SIGNED NOTE",DUZ))
- IF $ORDER(^AMHREC(AMHR,31,0))
- Begin DoDot:1
- +2 WRITE !!,"You cannot delete this record, the note has been electronically signed.",!,"Please see your supervisor or program manager."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- End DoDot:1
- QUIT
- +3 IF '$DATA(^XUSEC("AMHZ DELETE RECORD",DUZ))
- IF '$DATA(^XUSEC("AMHZ DELETE SIGNED NOTE",DUZ))
- WRITE !!,"You do not have the security access to delete a Visit.",!,"Please see your supervisor or program manager.",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +4 IF $$EHR^AMHUTIL(AMHR)
- DO EHRE^AMHEHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- DGSECD ;
- +1 IF '$PIECE(^AMHREC(AMHR,0),U,8)
- GOTO EDITD9
- +2 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +3 DO PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- +4 IF '$GET(AMHRESU(1))
- GOTO EDITD9
- +5 IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)
- DO DISPDG^AMHLE
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 DO DISPDG^AMHLE
- +7 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue to delete this record"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF 'Y
- DO XIT
- QUIT
- +9 KILL AMHRESU
- +10 DO NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITD9 ;
- +1 SET AMHACTN=4
- +2 IF '$GET(AMHGRPDE)
- Begin DoDot:1
- +3 DO EN^AMHRDSP
- +4 WRITE !!
- SET DIR(0)="Y"
- SET DIR("A")="Are you sure you want to DELETE this record"
- SET DIR("B")="N"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +5 IF $DATA(DIRUT)
- QUIT
- +6 IF 'Y
- QUIT
- End DoDot:1
- IF 'Y!($DATA(DIRUT))
- QUIT
- +7 DO DEL^AMHLEA
- +8 SET AMHACTN=4
- DO PCCLINK^AMHLEA
- +9 IF '$DATA(AMHPATCE)
- IF '$GET(AMHGRPDE)
- DO XIT
- +10 QUIT
- PRINT ;EP
- +1 IF AMHRCNT=0
- WRITE !,"There are no visits in the list to print."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +2 KILL DIR
- SET DIR(0)="N^1:"_AMHRCNT_":0"
- SET DIR("A")="Print Which Record"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- WRITE !,"No record selected."
- GOTO XIT
- +4 SET AMHR1=+Y
- IF 'AMHR1
- KILL VALMY,XQORNOD
- WRITE !,"No record selected."
- GOTO XIT
- +5 SET AMHR=^TMP("AMHVRECS",$JOB,"IDX",AMHR1,AMHR1)
- IF 'AMHR
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 IF '$DATA(^AMHREC(AMHR,0))
- WRITE !,"Not a valid BH RECORD."
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +7 DO FULL^VALM1
- DGSECP ;
- +1 IF '$PIECE(^AMHREC(AMHR,0),U,8)
- GOTO EDITP9
- +2 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +3 DO PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- +4 IF '$GET(AMHRESU(1))
- GOTO EDITP9
- +5 IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)
- DO DISPDG^AMHLE
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 DO DISPDG^AMHLE
- +7 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue to print this encounter form"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF 'Y
- DO XIT
- QUIT
- +9 KILL AMHRESU
- +10 DO NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITP9 ;
- +1 KILL AMHEFT
- +2 DO FORMDIR^AMHLEFP(AMHR)
- +3 IF $DATA(DIRUT)
- QUIT
- +4 SET AMHEFT=Y
- +5 DO FULL^VALM1
- +6 SET AMHACTN=5
- +7 SET XBRC="COMP^AMHLEFP"
- SET XBRP="^AMHLEFP2"
- SET XBNS="AMH"
- SET XBRX="XIT^AMHLEFP"
- +8 DO ^XBDBQUE
- +9 DO XIT
- +10 QUIT
- DISPLAY ;EP
- +1 IF AMHRCNT=0
- WRITE !,"There are no visits to display."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +2 KILL DIR
- SET DIR(0)="N^1:"_AMHRCNT_":0"
- SET DIR("A")="Display Which Record"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- WRITE !,"No record selected."
- GOTO XIT
- +4 SET AMHR1=+Y
- IF 'AMHR1
- KILL VALMY,XQORNOD
- WRITE !,"No record selected."
- GOTO XIT
- +5 SET AMHR=^TMP("AMHVRECS",$JOB,"IDX",AMHR1,AMHR1)
- IF 'AMHR
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 IF '$DATA(^AMHREC(AMHR,0))
- WRITE !,"Not a valid BH RECORD."
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +7 DO FULL^VALM1
- DGSECDS ;
- +1 IF '$PIECE(^AMHREC(AMHR,0),U,8)
- GOTO EDITDS9
- +2 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +3 DO PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- +4 IF '$GET(AMHRESU(1))
- GOTO EDITDS9
- +5 IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)
- DO DISPDG^AMHLE
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 DO DISPDG^AMHLE
- +7 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue to display this record"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF 'Y
- DO XIT
- QUIT
- +9 KILL AMHRESU
- +10 DO NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITDS9 ;
- DISP ;
- +1 SET AMHACTN=5
- +2 DO ^AMHDVD
- +3 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +4 DO OTHER^AMHLEA
- +5 DO XIT
- +6 QUIT
- APPT ;
- +1 DO FULL^VALM1
- +2 SET AMHACTN=6
- +3 DO GETPAT^AMHLEA
- +4 IF 'AMHPAT
- WRITE !,"NO Patient selected!",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +5 DO APPT^AMHVRL2(AMHPAT)
- +6 DO PAUSE^AMHLEA
- +7 DO XIT
- +8 QUIT
- HS ;EP - Display PP
- +1 DO FULL^VALM1
- +2 SET AMHACTN=6
- +3 DO GETPAT^AMHLEA
- +4 IF 'AMHPAT
- WRITE !,"NO Patient selected!",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +5 DO ^AMHDPP
- +6 DO PAUSE^AMHLEA
- +7 DO XIT
- +8 QUIT
- ID ;EP
- +1 DO FULL^VALM1
- +2 DO GETPAT^AMHLEA
- +3 IF 'AMHPAT
- WRITE !,"NO Patient selected!",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +4 DO EP^AMHLEIVP(AMHPAT)
- +5 DO PAUSE^AMHLEA
- +6 DO XIT
- +7 QUIT
- OI ;
- +1 DO FULL^VALM1
- +2 SET AMHACTN=6
- +3 DO GETPAT^AMHLEA
- +4 IF 'AMHPAT
- WRITE !,"NO Patient selected!",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +5 DO 1^AMHLEA
- +6 DO PAUSE^AMHLEA
- +7 DO XIT
- +8 QUIT
- SR ;EP
- +1 DO FULL^VALM1
- +2 DO GETPAT^AMHLEA
- +3 IF 'AMHPAT
- WRITE !,"NO Patient selected!",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +4 DO EP^AMHPST(AMHPAT)
- +5 DO PAUSE^AMHLEA
- +6 DO XIT
- +7 QUIT
- LAB ;
- +1 DO FULL^VALM1
- +2 SET AMHACTN=6
- +3 DO GETPAT^AMHLEA
- +4 IF 'AMHPAT
- WRITE !,"NO Patient selected!",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +5 SET DFN=AMHPAT
- SET ORVP=AMHPAT_";DPT("
- DO OR^LRRP2
- KILL DFN
- +6 DO PAUSE^AMHLEA
- +7 DO XIT
- +8 QUIT
- TIUN ;EP
- +1 IF AMHRCNT=0
- WRITE !,"There are no visits in the list to display."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +2 KILL DIR
- SET DIR(0)="N^1:"_AMHRCNT_":0"
- SET DIR("A")="Display Note for Which Record"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +3 IF $DATA(DIRUT)
- WRITE !,"No record selected."
- GOTO XIT
- +4 SET AMHR1=+Y
- IF 'AMHR1
- KILL VALMY,XQORNOD
- WRITE !,"No record selected."
- GOTO XIT
- +5 SET AMHR=^TMP("AMHVRECS",$JOB,"IDX",AMHR1,AMHR1)
- IF 'AMHR
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 IF '$DATA(^AMHREC(AMHR,0))
- WRITE !,"Not a valid BH RECORD."
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +7 IF '$ORDER(^AMHREC(AMHR,54,0))
- WRITE !,"There is no TIU Note associated with that visit."
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +8 DO FULL^VALM1
- DGSECT ;
- +1 IF '$PIECE(^AMHREC(AMHR,0),U,8)
- GOTO EDITT9
- +2 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +3 DO PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- +4 IF '$GET(AMHRESU(1))
- GOTO EDITT9
- +5 IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)
- DO DISPDG^AMHLE
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 DO DISPDG^AMHLE
- +7 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue to display the TIU note"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF 'Y
- DO XIT
- QUIT
- +9 KILL AMHRESU
- +10 DO NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITT9 ;
- TIUN1 ;
- +1 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +2 DO TIU^AMHEHR
- +3 DO XIT
- +4 QUIT
- ESIG ;EP - PROTOCOL
- +1 NEW AMHXX,AMHR,AMHR1
- +2 IF AMHRCNT=0
- WRITE !,"There are no visits in the list to sign."
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +3 KILL DIR
- SET DIR(0)="N^1:"_AMHRCNT_":0"
- SET DIR("A")="Sign Which Record"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +4 IF $DATA(DIRUT)
- WRITE !,"No record selected."
- GOTO XIT
- +5 SET AMHR1=+Y
- IF 'AMHR1
- KILL VALMY,XQORNOD
- WRITE !,"No record selected."
- GOTO XIT
- +6 SET AMHR=^TMP("AMHVRECS",$JOB,"IDX",AMHR1,AMHR1)
- IF 'AMHR
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +7 IF '$DATA(^AMHREC(AMHR,0))
- WRITE !,"Not a valid BH RECORD."
- KILL AMHRDEL,AMHR
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +8 IF $PIECE(^AMHREC(AMHR,0),U,34)
- WRITE !!,"This is a group encounter. You must sign this note through the Group",!,"Form Data Entry menu option.",!
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +9 DO FULL^VALM1
- DGSECS ;
- +1 IF '$PIECE(^AMHREC(AMHR,0),U,8)
- GOTO EDITS9
- +2 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- +3 DO PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
- +4 IF '$GET(AMHRESU(1))
- GOTO EDITS9
- +5 IF $GET(AMHRESU(1))=3!($GET(AMHRESU(1))=4)!($GET(AMHRESU(1))=5)
- DO DISPDG^AMHLE
- DO PAUSE^AMHLEA
- DO XIT
- QUIT
- +6 DO DISPDG^AMHLE
- +7 WRITE !
- KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to continue to sign this note"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +8 IF 'Y
- DO XIT
- QUIT
- +9 KILL AMHRESU
- +10 DO NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
- EDITS9 ;
- +1 SET AMHXX=$$ESIG^AMHESIG(AMHR)
- +2 IF 'AMHXX
- WRITE !!,$PIECE(AMHXX,U,3),!
- DO PAUSE^AMHLEA
- IF '$PIECE(AMHXX,U,4)
- DO XIT
- QUIT
- ESIGD ;
- +1 SET AMHACTN=5
- +2 DO ^AMHDVD
- +3 SET AMHPAT=$PIECE(^AMHREC(AMHR,0),U,8)
- ESIGE ;
- +1 WRITE !!
- +2 SET DIR(0)="Y"
- SET DIR("A")="Do you wish to edit this record/note"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- DO XIT
- QUIT
- +4 IF 'Y
- DO ESIG9
- QUIT
- +5 DO EDIT
- +6 DO XIT
- +7 QUIT
- ESIG9 ;
- +1 DO OTHER^AMHLEA
- +2 SET AMHACTN=1
- +3 DO PCCLINK^AMHLEA
- +4 DO XIT
- +5 QUIT
- XIT ;EP
- +1 SET VALMBCK="R"
- +2 DO TERM^VALM0
- +3 DO GATHER^AMHLEL
- +4 SET VALMCNT=AMHRCNT
- +5 DO HDR^AMHLE
- EOJ KILL AMHR,AMHTYPE,AMHR0,AMHERROR,AMHC,AMHRPOV,AMHX,AMHSHIGH,AMHOTH,AMHOKAY,AMHNONE,AMHACTN,AMHLOC,AMHPAT,DA,DIE,DIRUT,DUOUT,DIC,D0,AMHVDLT,AMHR1,DFN
- +1 KILL AMHTYPE,AMHECLN,AMHSD,AMHVISIT,AMHRESU
- +2 DO KILL^AUPNPAT
- +3 KILL DFN,AGE,SSN
- +4 KILL DGXFRO,DGB
- +5 QUIT