AMHPCCL ; IHS/CMI/LAB - PCC LINK FROM BH 29 May 2006 4:37 PM 03 Jun 2009 3:08 PM ;
;;4.0;IHS BEHAVIORAL HEALTH;**1,2,8**;JUN 02, 2010;Build 7
;
;AMHR=BH RECORD NUMBER
;AMHACTN=ACTION TO BE TAKEN
;
START ;EP - ENTRY POINT BY TASKMAN
Q:$P($G(^AMHREC(AMHR,11)),U,10)
NEW P,X
S P=$$PPINT^AMHUTIL(AMHR) I P S X=$O(^AMHSITE(DUZ(2),11,"B",P,0)) I X,$P($G(^AMHSITE(DUZ(2),11,X,0)),U,2)=1 Q ;no link for this provider
I '$D(ZTQUEUED) W:'$D(AMHBL) !!,"Generating PCC Visit.",!
LOCK +^AMHREC(AMHR,0):10 E Q ;lock AMH record
I AMHACTN'=4 S AMHR0=^AMHREC(AMHR,0)
D @AMHACTN
D XIT
Q
1 ;add a visit
I '$D(^AMHREC(AMHR)) Q
ADD1 ;
S AMHERR=""
I $G(AMHGUIV) S AMHVSIT=AMHGUIV G VF
I $L($T(^APCDAPI4)),$L($T(GETVISIT^BSDAPI4)) D Q
.D BSD I AMHERR]"" W:'$G(AMHBL) !!,"PCC Visit not created, notify supervisor",!,"PCC visit creation error: ",AMHERR D:'$G(AMHBL) PAUSE^AMHLEA Q
.I '$G(AMHVSIT) W:'$G(AMHBL) !!,"Visit not created...notify supervisor." Q
.D VF
.Q
D SETVISIT
D ^APCDALV
I $G(APCDALVR("APCDAFLG"))=1,'$G(AMHBL) W !!,"PCC Visit not created, try again." G ADD1
I $D(APCDALVR("APCDAFLG")) S AMHBN="VISIT" D @("V"_APCDALVR("APCDAFLG")) Q
S AMHVSIT=APCDALVR("APCDVSIT")
VF ;
K DR,DA,DIE S DA=AMHR,DIE="^AMHREC(",DR=".16////"_AMHVSIT_";1111////1" D CALLDIE^AMHLEIN
I '$P($G(^AMHSITE(DUZ(2),18)),U,8) K DR,DA,DIE S DA=AMHVSIT,DIE="^AUPNVSIT(",DR="1111///R" D CALLDIE^AMHLEIN ;reviewed/complete set as yes for all BH visits
I $P($G(^AMHSITE(DUZ(2),18)),U,8) K DR,DA,DIE S DA=AMHVSIT,DIE="^AUPNVSIT(",DR="1111///I" D CALLDIE^AMHLEIN
I $P($G(^APCCCTRL(DUZ(2),0)),U,12)]"",$P($P(^AMHREC(AMHR,0),U),".")<$P($G(^APCCCTRL(DUZ(2),0)),U,12) K DR,DA,DIE S DA=AMHVSIT,DIE="^AUPNVSIT(",DR="1111///R" D CALLDIE^AMHLEIN
D VFILES^AMHPCCL1
;NO ERROR CHECK ABOVE !!
Q
2 ;EDIT A VISIT (DELETE AND ADD V FILES)
I '$D(^AMHREC(AMHR)) Q ;huh - no record to use for edit
;set up APCDALVR vars for VISIT, call to modify
;if visit date/time changed, call APCDCVDT
;then delete all V POVS, vproviders and vactivity times.
;d VFILES^AMHPCCL1
S AMHVSIT=$P(AMHR0,U,16) ;get existing pcc visit
I AMHVSIT="" D 1 Q ;says to edit, but no visit created, so go do add and quit
I '$D(^AUPNVSIT(AMHVSIT)) K DIE,DA,DR,DIU,DIV,DIW S DA=AMHR,DIE="^AMHREC(",DR=".16///@" D ^DIE K DIE,DA,DR,DIU,DIV,DIW D 1 Q
I $P(^AUPNVSIT(AMHVSIT,0),U,11) K DIE,DA,DR,DIU,DIV,DIW S DA=AMHR,DIE="^AMHREC(",DR=".16///@" D ^DIE K DIE,DA,DR,DIU,DIV,DIW D 1 Q
D SETVISIT
S APCDALVR("APCDATMP")="[APCDALVR 9000010 (MOD)]"
S APCDALVR("APCDVSIT")=AMHVSIT
S APCDALVR("APCDLOC")="`"_APCDALVR("APCDLOC")
S APCDALVR("APCDHL")=$$VALI^XBDIQ1(9002011,AMHR,1117) ;IHS/CMI/LAB PATCH 8 HOSP LOC
D ^APCDALVR ;edit existing visit entry
I $D(APCDALVR("APCDAFLG")) S AMHBN="VISIT" D V9 Q
I $P(^AUPNVSIT(AMHVSIT,0),U)'=$P(AMHR0,U) D
.S APCDCVDT("VISIT DFN")=AMHVSIT
.S APCDCVDT("VISIT DATE/TIME")=$P(AMHR0,U)_$S($P($P(AMHR0,U),".",2)]"":"",1:".12")
.S APCDCVDT("TALK")=1
.D ^APCDCVDT
.I $D(APCDCVDT("ERROR FLAG")) W !!,$C(7),$C(7),"Error changing PCC Visit Date and Time...PLEASE NOTIFY SITE MANAGER",! H 5
.K APCDCVDT
.Q
;delete all providers
S AMHX=0 F S AMHX=$O(^AUPNVPRV("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVPRV(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVPOV("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVPOV(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVTM("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVTM(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVCPT("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVCPT(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVPED("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVPED(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVHF("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVHF(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVXAM("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVXAM(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVMSR("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVMSR(" D ^DIK K DA,DR,DIK
D VFILES^AMHPCCL1
Q
3 ;APPEND
I '$D(^AMHREC(AMHR)) Q ;huh - no record to use for edit
S AMHVSIT=$P(AMHR0,U,16) ;get existing pcc visit
I AMHVSIT="" D 1 Q ;says to append, but no visit created, so go do add and quit
;delete all providers
S AMHX=0 F S AMHX=$O(^AUPNVPRV("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVPRV(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVPOV("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVPOV(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVTM("AD",AMHVSIT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVTM(" D ^DIK K DA,DR,DIK
D VFILES^AMHPCCL1
Q
SETVISIT ;set up visit values
D KILL
S APCDALVR("AUPNTALK")=""
S APCDALVR("APCDDATE")=$P(AMHR0,U)
D GETTYPE
S APCDALVR("APCDPAT")=$P(AMHR0,U,8)
S APCDALVR("APCDLOC")=$P(AMHR0,U,4)
;determine service category based on type of contact
S APCDALVR("APCDCAT")=$P(^AMHTSET($P(AMHR0,U,7),0),U,3)
I '$P($G(^AMHSITE(DUZ(2),0)),U,33) S APCDALVR("APCDAUTO")=""
I $D(ZTQUEUED) S APCDALVR("APCDAUTO")=""
S APCDALVR("APCDANE")=""
;S APCDALVR("APCDADD")=1 ;always create new visit because 12 is used and 2 visits on same day attach to each other, should never be here except on new visits
I '$P($G(^AMHSITE(DUZ(2),0)),U,33) S APCDALVR("APCDADD")=1
I $D(ZTQUEUED) S APCDALVR("APCDADD")=1
D GETCLN
I APCDALVR("APCDCAT")="I" S APCDALVR("APCDCLN")="" ;PER LESLIE RACINE
I APCDALVR("APCDCLN")]"" S APCDALVR("APCDCLN")="`"_APCDALVR("APCDCLN")
S APCDALVR("APCDAPPT")=$P(AMHR0,U,11)
S APCDALVR("APCDOLOC")=$P(AMHR0,U,26)
S APCDALVR("APCDEVM")=$P(AMHR0,U,29)
S APCDALVR("APCDHL")=$$VALI^XBDIQ1(9002011,AMHR,1117) ;IHS/CMI/LAB PATCH 8 HOSP LOC
Q
GETCLN ;determine clinic to pass
S APCDALVR("APCDCLN")=""
NEW X
S X=$P(AMHR0,U,7)
I X="" G GETCLN1
I $P($G(^AMHTSET(X,0)),U,2)=9 S APCDALVR("APCDCLN")=$O(^DIC(40.7,"C",30,"")) Q:APCDALVR("APCDCLN")]""
I $P($G(^AMHTSET(X,0)),U,2)=5 S APCDALVR("APCDCLN")=$O(^DIC(40.7,"C",11,"")) Q:APCDALVR("APCDCLN")]""
GETCLN1 ;
S APCDALVR("APCDCLN")=$P(AMHR0,U,25)
Q:APCDALVR("APCDCLN")]""
S APCDALVR("APCDCLN")=$S($P(AMHR0,U,2)="M":$O(^DIC(40.7,"C",14,"")),$P(AMHR0,U,2)="S":$O(^DIC(40.7,"C",48,"")),$P(AMHR0,U,2)="C":$O(^DIC(40.7,"C",43,0)),1:$O(^DIC(40.7,"C",C4,"")))
I APCDALVR("APCDCLN")="" S APCDALVR("APCDCLN")=$O(^DIC(40.7,"C",25,""))
Q
4 ;delete visit in PCC
W !,"Deleting associated PCC Visit.",!
S APCDVDLT=$G(AMHVDLT) I APCDVDLT="" Q
S AMHX=0 F S AMHX=$O(^AUPNVPRV("AD",AMHVDLT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVPRV(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVPOV("AD",AMHVDLT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVPOV(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVTM("AD",AMHVDLT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVTM(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVCPT("AD",AMHVDLT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVCPT(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVPED("AD",AMHVDLT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVPED(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVHF("AD",AMHVDLT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVHF(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVXAM("AD",AMHVDLT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVXAM(" D ^DIK K DA,DR,DIK
S AMHX=0 F S AMHX=$O(^AUPNVMSR("AD",AMHVDLT,AMHX)) Q:AMHX'=+AMHX S DA=AMHX,DIK="^AUPNVMSR(" D ^DIK K DA,DR,DIK
;D ^APCDVDLT
S AUPNVSIT=AMHVDLT D MOD^AUPNVSIT K AUPNVSIT
I '$P(^AUPNVSIT(AMHVDLT,0),U,9) S APCDVDLT=$G(AMHVDLT) D ^APCDVDLT
Q
KILL ;
K APCDALVR,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDCLN,APCDTPRO,APCDTPS,APCDTPOV,APCDTNQ,APCDTTOP,APCDTLOU,APCDTPRV,APCDTAT,APCDATMP,APCDAFLG,APCDAUTO,APCDANE,AUPNTALK,APCDAPPT,APCDOLOC
Q
GETTYPE ;get type of visit - use loc current type or affiliation of provider
S APCDALVR("APCDTYPE")=$S($P($G(^AMHSITE(DUZ(2),0)),U,2)]"":$P(^(0),U,2),1:"") Q:APCDALVR("APCDTYPE")]""
;S X=$P(^AUTTLOC($P(AMHR0,U,4),0),U,25) I X]"" S APCDALVR("APCDTYPE")=$S(X=1:"I",X=2:"6",X=3:"C",X=4:"U",X=5:"S",X=6:"T",1:"O") Q
S X=$P($G(^APCCCTRL($P(AMHR0,U,4),0)),U,4) I X]"" S APCDALVR("APCDTYPE")=X Q ;use pcc master control for site of loc of enc ihs/tucson/lab 11/30/95 patch 1
S X=$$PPAFFL^AMHUTIL(AMHR,"I") I X S APCDALVR("APCDTYPE")=$S(X=1:"I",X=2:"C",X=3:"T",X=8:"6",1:"") I APCDALVR("APCDTYPE")]"" Q
S X=$P($G(^APCCCTRL(DUZ(2),0)),U,4) I X]"" S APCDALVR("APCDTYPE")=X Q ;use pcc master control
S APCDALVR("APCDTYPE")="I" ;default to I if can't determine
Q
XIT ;CLEAN UP AND EXIT
D KILL
LOCK -^AMHREC(AMHR,0)
K AMHA,AMHACTN,APCDVDLT,AMHERROR,AMHBN,AMHHOLDC,AMHVFILE,AMHX,X,Y,DIE,DA,DIU,DIV,DIW,DR,APCDALVR,AMHDUZ,AMHVSIT,AMHR0,AMHLOOK,AMHGOT,AMHVISIT,AMHCOM,AMHP,AMHRES
D ^XBFMK
Q
V2 S AMHERROR="inability to create visit" G LBULL
V3 S AMHERROR="invalid visit parameters (date, location etc.)" G LBULL
V9 S AMHERROR="unable to modify visit entry "_AMHVSIT G LBULL
;
E1 S AMHERROR="incorrect template specification" G LBULL
E2 S AMHERROR="invalid values being passed to "_AMHVFILE G LBULL
;
LBULL ; SEND BULLETIN - LINK FAILURE
K XMB
S XMB(1)=AMHR,XMB(2)=$P(^DPT($P(AMHR0,U,8),0),U)_" (DFN "_$P(AMHR0,U,8)_")",Y=$P(AMHR0,U) D DD^%DT S XMB(3)=Y,XMB(4)=AMHERROR,XMB(5)=$G(AMHVFILE),XMB="AMH PCC LINK FAIL "_AMHBN
D ^XMB K XMB,AMHERROR,AMHBN,AMHVFILE
Q
BSD ;
;if non-interactive use APCDAPI4 and always force an add
;in interative mode display to user for selection
K AMHIN,AMHHOLDC ;clean out array
D KILL
I '$P($G(^AMHSITE(DUZ(2),0)),U,33) S AMHIN("FORCE ADD")=1
I $D(ZTQUEUED) S AMHIN("FORCE ADD")=1
S AMHIN("VISIT DATE")=$P(AMHR0,U)
D GETTYPE
S AMHIN("VISIT TYPE")=APCDALVR("APCDTYPE")
S AMHIN("PAT")=$P(AMHR0,U,8)
S AMHIN("SITE")=$P(AMHR0,U,4)
;determine service category based on type of contact
S AMHIN("SRV CAT")=$P(^AMHTSET($P(AMHR0,U,7),0),U,3)
D GETCLN
S AMHHOLDC=$G(APCDALVR("APCDCLN"))
;I APCDALVR("APCDCLN")]"" S AMHIN("CLINIC CODE")=APCDALVR("APCDCLN")
S AMHIN("APCDAPPT")=$P(AMHR0,U,11)
S AMHIN("APCDOLOC")=$P(AMHR0,U,26)
S AMHIN("APCDEVM")=$P(AMHR0,U,29)
S AMHIN("APCDOPT")=$P($G(XQY0),U) I AMHIN("APCDOPT")]"" S AMHIN("APCDOPT")=$O(^DIC(19,"B",AMHIN("APCDOPT"),0))
;S AMHIN("PROVIDER")=$$PPINT^AMHUTIL(AMHR)
S AMHIN("APCDCAF")=$S($P($G(^AMHSITE(DUZ(2),18)),U,8):"I",1:"R")
S AMHIN("TIME RANGE")=-1
S AMHIN("USR")=DUZ
S AMHIN("HOS LOC")=$$VALI^XBDIQ1(9002011,AMHR,1117)
BSDADD1 ;
K APCDALVR
K AMHV
D GETVISIT^APCDAPI4(.AMHIN,.AMHV)
S AMHERR=$P(AMHV(0),U,2)
I AMHERR]"" Q ;errored
I $P(AMHV(0),U)=1 S V=$O(AMHV(0)) I AMHV(V)="ADD" S AMHVSIT=V D SETCLN Q
;since more than one passed back display them to the user and quit
SELECT ; SELECT EXISTING VISIT
W !!,"PATIENT: ",$P(^DPT($P(AMHR0,U,8),0),U)," has one or more VISITs on ",$$FMTE^XLFDT($P(AMHR0,U)),".",!,"If one of these is your visit, please select it",!
K AMHV1 S (AMHC,AMHA,AMHX)="",AMHV1=0 F S AMHV1=$O(AMHV(AMHV1)) Q:AMHV1'=+AMHV1 S AMHX=$G(^AUPNVSIT(AMHV1,0)),AMHX11=$G(^AUPNVSIT(AMHV1,11)) D WRITE
S AMHC=AMHC+1 W !,AMHC," Create New Visit",!
K DIR
S DIR(0)="N^1:"_AMHC,DIR("A")="Select" KILL DA D ^DIR KILL DIR
I $D(DIRUT) S AMHIN("FORCE ADD")=1 S AMHIN("CLINIC CODE")=AMHHOLDC G BSDADD1
I AMHC=Y S AMHIN("FORCE ADD")=1 S AMHIN("CLINIC CODE")=AMHHOLDC G BSDADD1
S AMHVSIT=AMHX1(Y)
K AMHIN,APCDALVR
Q
;
WRITE ; WRITE VISITS FOR SELECT
S AMHC=AMHC+1,AMHX1(AMHC)=AMHV1
S AMHVLT=$P(+AMHX,".",2),AMHVLT=$S(AMHVLT="":"<NONE>",$L(AMHVLT)=1:AMHVLT_"0:00 ",1:$E(AMHVLT,1,2)_":"_$E(AMHVLT,3,4)_$E("00",1,2-$L($E(AMHVLT,3,4)))_" ")
S AMHVLOC=""
I $P(AMHX,U,6),$D(^AUTTLOC($P(AMHX,U,6),0)) S AMHVLOC=$P(^(0),U,7),AMHVLOC=AMHVLOC_$E(" ",1,4-$L(AMHVLOC))
S:AMHVLOC="" AMHVLOC="...."
W !,AMHC," TIME: ",AMHVLT,"LOC: ",AMHVLOC," TYPE: ",$P(AMHX,U,3)," CAT: ",$P(AMHX,U,7)," CLINIC: ",$S($P(AMHX,U,8)]"":$E($P(^DIC(40.7,$P(AMHX,U,8),0),U),1,8),1:"<NONE>") D
.W ?57,"DEC: ",$S($P(AMHX,U,9):$P(AMHX,U,9),1:0),$S($P(AMHX11,U,3)]"":" VCN:"_$P(AMHX11,U,3),1:"")
.I $P(AMHX,U,22) W !?3,"Hospital Location: ",$P($G(^SC($P(AMHX,U,22),0)),U)
.S AMHTIU=$$PRIMPROV^APCLV(AMHV1,"N") I AMHTIU]"" W !?3,"Provider on Visit: ",AMHTIU
.S AMHTIU=$O(^AUPNVNOT("AD",AMHV1,0)) I AMHTIU W !?3,"TIU Note: ",$$VAL^XBDIQ1(9000010.28,AMHTIU,.01)," AUTHOR: ",$$VAL^XBDIQ1(9000010.28,AMHTIU,1202)
.S AMHTIU=$$PRIMPOV^APCLV(AMHV1,"C") W !?3,"Primary POV: ",AMHTIU," Narrative: ",$E($$PRIMPOV^APCLV(AMHV1,"N"),1,40)
K AMHVLT,AMHVLOC,AMHTIU
Q
MRG ;EP
S DA=$O(^AMHREC("AVISIT",APCDVMF,0))
I DA S DIE="^AMHREC(",DR=".16////"_APCDVMT D ^DIE K DIE,DA,DR
Q
DEL ;EP
S DA=$O(^AMHREC("AVISIT",APCDVDLT,0))
I DA,$P($G(^AMHREC(DA,11)),U,10) S AMHRDEL=DA D EN^AMHLEDEL Q
I DA S DIE="^AMHREC(",DR=".16///@" D ^DIE K DIE,DA
Q
SETCLN ;
NEW DA,DIE,DR
S DA=AMHVSIT,DIE="^AUPNVSIT(",DR=".08////"_AMHHOLDC
D ^DIE
Q
AMHPCCL ; IHS/CMI/LAB - PCC LINK FROM BH 29 May 2006 4:37 PM 03 Jun 2009 3:08 PM ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;**1,2,8**;JUN 02, 2010;Build 7
+2 ;
+3 ;AMHR=BH RECORD NUMBER
+4 ;AMHACTN=ACTION TO BE TAKEN
+5 ;
START ;EP - ENTRY POINT BY TASKMAN
+1 IF $PIECE($GET(^AMHREC(AMHR,11)),U,10)
QUIT
+2 NEW P,X
+3 ;no link for this provider
SET P=$$PPINT^AMHUTIL(AMHR)
IF P
SET X=$ORDER(^AMHSITE(DUZ(2),11,"B",P,0))
IF X
IF $PIECE($GET(^AMHSITE(DUZ(2),11,X,0)),U,2)=1
QUIT
+4 IF '$DATA(ZTQUEUED)
IF '$DATA(AMHBL)
WRITE !!,"Generating PCC Visit.",!
+5 ;lock AMH record
LOCK +^AMHREC(AMHR,0):10
IF '$TEST
QUIT
+6 IF AMHACTN'=4
SET AMHR0=^AMHREC(AMHR,0)
+7 DO @AMHACTN
+8 DO XIT
+9 QUIT
1 ;add a visit
+1 IF '$DATA(^AMHREC(AMHR))
QUIT
ADD1 ;
+1 SET AMHERR=""
+2 IF $GET(AMHGUIV)
SET AMHVSIT=AMHGUIV
GOTO VF
+3 IF $LENGTH($TEXT(^APCDAPI4))
IF $LENGTH($TEXT(GETVISIT^BSDAPI4))
Begin DoDot:1
+4 DO BSD
IF AMHERR]""
IF '$GET(AMHBL)
WRITE !!,"PCC Visit not created, notify supervisor",!,"PCC visit creation error: ",AMHERR
IF '$GET(AMHBL)
DO PAUSE^AMHLEA
QUIT
+5 IF '$GET(AMHVSIT)
IF '$GET(AMHBL)
WRITE !!,"Visit not created...notify supervisor."
QUIT
+6 DO VF
+7 QUIT
End DoDot:1
QUIT
+8 DO SETVISIT
+9 DO ^APCDALV
+10 IF $GET(APCDALVR("APCDAFLG"))=1
IF '$GET(AMHBL)
WRITE !!,"PCC Visit not created, try again."
GOTO ADD1
+11 IF $DATA(APCDALVR("APCDAFLG"))
SET AMHBN="VISIT"
DO @("V"_APCDALVR("APCDAFLG"))
QUIT
+12 SET AMHVSIT=APCDALVR("APCDVSIT")
VF ;
+1 KILL DR,DA,DIE
SET DA=AMHR
SET DIE="^AMHREC("
SET DR=".16////"_AMHVSIT_";1111////1"
DO CALLDIE^AMHLEIN
+2 ;reviewed/complete set as yes for all BH visits
IF '$PIECE($GET(^AMHSITE(DUZ(2),18)),U,8)
KILL DR,DA,DIE
SET DA=AMHVSIT
SET DIE="^AUPNVSIT("
SET DR="1111///R"
DO CALLDIE^AMHLEIN
+3 IF $PIECE($GET(^AMHSITE(DUZ(2),18)),U,8)
KILL DR,DA,DIE
SET DA=AMHVSIT
SET DIE="^AUPNVSIT("
SET DR="1111///I"
DO CALLDIE^AMHLEIN
+4 IF $PIECE($GET(^APCCCTRL(DUZ(2),0)),U,12)]""
IF $PIECE($PIECE(^AMHREC(AMHR,0),U),".")<$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,12)
KILL DR,DA,DIE
SET DA=AMHVSIT
SET DIE="^AUPNVSIT("
SET DR="1111///R"
DO CALLDIE^AMHLEIN
+5 DO VFILES^AMHPCCL1
+6 ;NO ERROR CHECK ABOVE !!
+7 QUIT
2 ;EDIT A VISIT (DELETE AND ADD V FILES)
+1 ;huh - no record to use for edit
IF '$DATA(^AMHREC(AMHR))
QUIT
+2 ;set up APCDALVR vars for VISIT, call to modify
+3 ;if visit date/time changed, call APCDCVDT
+4 ;then delete all V POVS, vproviders and vactivity times.
+5 ;d VFILES^AMHPCCL1
+6 ;get existing pcc visit
SET AMHVSIT=$PIECE(AMHR0,U,16)
+7 ;says to edit, but no visit created, so go do add and quit
IF AMHVSIT=""
DO 1
QUIT
+8 IF '$DATA(^AUPNVSIT(AMHVSIT))
KILL DIE,DA,DR,DIU,DIV,DIW
SET DA=AMHR
SET DIE="^AMHREC("
SET DR=".16///@"
DO ^DIE
KILL DIE,DA,DR,DIU,DIV,DIW
DO 1
QUIT
+9 IF $PIECE(^AUPNVSIT(AMHVSIT,0),U,11)
KILL DIE,DA,DR,DIU,DIV,DIW
SET DA=AMHR
SET DIE="^AMHREC("
SET DR=".16///@"
DO ^DIE
KILL DIE,DA,DR,DIU,DIV,DIW
DO 1
QUIT
+10 DO SETVISIT
+11 SET APCDALVR("APCDATMP")="[APCDALVR 9000010 (MOD)]"
+12 SET APCDALVR("APCDVSIT")=AMHVSIT
+13 SET APCDALVR("APCDLOC")="`"_APCDALVR("APCDLOC")
+14 ;IHS/CMI/LAB PATCH 8 HOSP LOC
SET APCDALVR("APCDHL")=$$VALI^XBDIQ1(9002011,AMHR,1117)
+15 ;edit existing visit entry
DO ^APCDALVR
+16 IF $DATA(APCDALVR("APCDAFLG"))
SET AMHBN="VISIT"
DO V9
QUIT
+17 IF $PIECE(^AUPNVSIT(AMHVSIT,0),U)'=$PIECE(AMHR0,U)
Begin DoDot:1
+18 SET APCDCVDT("VISIT DFN")=AMHVSIT
+19 SET APCDCVDT("VISIT DATE/TIME")=$PIECE(AMHR0,U)_$SELECT($PIECE($PIECE(AMHR0,U),".",2)]"":"",1:".12")
+20 SET APCDCVDT("TALK")=1
+21 DO ^APCDCVDT
+22 IF $DATA(APCDCVDT("ERROR FLAG"))
WRITE !!,$CHAR(7),$CHAR(7),"Error changing PCC Visit Date and Time...PLEASE NOTIFY SITE MANAGER",!
HANG 5
+23 KILL APCDCVDT
+24 QUIT
End DoDot:1
+25 ;delete all providers
+26 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVPRV("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVPRV("
DO ^DIK
KILL DA,DR,DIK
+27 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVPOV("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVPOV("
DO ^DIK
KILL DA,DR,DIK
+28 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVTM("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVTM("
DO ^DIK
KILL DA,DR,DIK
+29 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVCPT("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVCPT("
DO ^DIK
KILL DA,DR,DIK
+30 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVPED("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVPED("
DO ^DIK
KILL DA,DR,DIK
+31 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVHF("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVHF("
DO ^DIK
KILL DA,DR,DIK
+32 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVXAM("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVXAM("
DO ^DIK
KILL DA,DR,DIK
+33 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVMSR("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVMSR("
DO ^DIK
KILL DA,DR,DIK
+34 DO VFILES^AMHPCCL1
+35 QUIT
3 ;APPEND
+1 ;huh - no record to use for edit
IF '$DATA(^AMHREC(AMHR))
QUIT
+2 ;get existing pcc visit
SET AMHVSIT=$PIECE(AMHR0,U,16)
+3 ;says to append, but no visit created, so go do add and quit
IF AMHVSIT=""
DO 1
QUIT
+4 ;delete all providers
+5 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVPRV("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVPRV("
DO ^DIK
KILL DA,DR,DIK
+6 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVPOV("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVPOV("
DO ^DIK
KILL DA,DR,DIK
+7 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVTM("AD",AMHVSIT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVTM("
DO ^DIK
KILL DA,DR,DIK
+8 DO VFILES^AMHPCCL1
+9 QUIT
SETVISIT ;set up visit values
+1 DO KILL
+2 SET APCDALVR("AUPNTALK")=""
+3 SET APCDALVR("APCDDATE")=$PIECE(AMHR0,U)
+4 DO GETTYPE
+5 SET APCDALVR("APCDPAT")=$PIECE(AMHR0,U,8)
+6 SET APCDALVR("APCDLOC")=$PIECE(AMHR0,U,4)
+7 ;determine service category based on type of contact
+8 SET APCDALVR("APCDCAT")=$PIECE(^AMHTSET($PIECE(AMHR0,U,7),0),U,3)
+9 IF '$PIECE($GET(^AMHSITE(DUZ(2),0)),U,33)
SET APCDALVR("APCDAUTO")=""
+10 IF $DATA(ZTQUEUED)
SET APCDALVR("APCDAUTO")=""
+11 SET APCDALVR("APCDANE")=""
+12 ;S APCDALVR("APCDADD")=1 ;always create new visit because 12 is used and 2 visits on same day attach to each other, should never be here except on new visits
+13 IF '$PIECE($GET(^AMHSITE(DUZ(2),0)),U,33)
SET APCDALVR("APCDADD")=1
+14 IF $DATA(ZTQUEUED)
SET APCDALVR("APCDADD")=1
+15 DO GETCLN
+16 ;PER LESLIE RACINE
IF APCDALVR("APCDCAT")="I"
SET APCDALVR("APCDCLN")=""
+17 IF APCDALVR("APCDCLN")]""
SET APCDALVR("APCDCLN")="`"_APCDALVR("APCDCLN")
+18 SET APCDALVR("APCDAPPT")=$PIECE(AMHR0,U,11)
+19 SET APCDALVR("APCDOLOC")=$PIECE(AMHR0,U,26)
+20 SET APCDALVR("APCDEVM")=$PIECE(AMHR0,U,29)
+21 ;IHS/CMI/LAB PATCH 8 HOSP LOC
SET APCDALVR("APCDHL")=$$VALI^XBDIQ1(9002011,AMHR,1117)
+22 QUIT
GETCLN ;determine clinic to pass
+1 SET APCDALVR("APCDCLN")=""
+2 NEW X
+3 SET X=$PIECE(AMHR0,U,7)
+4 IF X=""
GOTO GETCLN1
+5 IF $PIECE($GET(^AMHTSET(X,0)),U,2)=9
SET APCDALVR("APCDCLN")=$ORDER(^DIC(40.7,"C",30,""))
IF APCDALVR("APCDCLN")]""
QUIT
+6 IF $PIECE($GET(^AMHTSET(X,0)),U,2)=5
SET APCDALVR("APCDCLN")=$ORDER(^DIC(40.7,"C",11,""))
IF APCDALVR("APCDCLN")]""
QUIT
GETCLN1 ;
+1 SET APCDALVR("APCDCLN")=$PIECE(AMHR0,U,25)
+2 IF APCDALVR("APCDCLN")]""
QUIT
+3 SET APCDALVR("APCDCLN")=$SELECT($PIECE(AMHR0,U,2)="M":$ORDER(^DIC(40.7,"C",14,"")),$PIECE(AMHR0,U,2)="S":$ORDER(^DIC(40.7,"C",48,"")),$PIECE(AMHR0,U,2)="C":$ORDER(^DIC(40.7,"C",43,0)),1:$ORDER(^DIC(40.7,"C",C4,"")))
+4 IF APCDALVR("APCDCLN")=""
SET APCDALVR("APCDCLN")=$ORDER(^DIC(40.7,"C",25,""))
+5 QUIT
4 ;delete visit in PCC
+1 WRITE !,"Deleting associated PCC Visit.",!
+2 SET APCDVDLT=$GET(AMHVDLT)
IF APCDVDLT=""
QUIT
+3 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVPRV("AD",AMHVDLT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVPRV("
DO ^DIK
KILL DA,DR,DIK
+4 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVPOV("AD",AMHVDLT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVPOV("
DO ^DIK
KILL DA,DR,DIK
+5 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVTM("AD",AMHVDLT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVTM("
DO ^DIK
KILL DA,DR,DIK
+6 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVCPT("AD",AMHVDLT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVCPT("
DO ^DIK
KILL DA,DR,DIK
+7 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVPED("AD",AMHVDLT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVPED("
DO ^DIK
KILL DA,DR,DIK
+8 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVHF("AD",AMHVDLT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVHF("
DO ^DIK
KILL DA,DR,DIK
+9 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVXAM("AD",AMHVDLT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVXAM("
DO ^DIK
KILL DA,DR,DIK
+10 SET AMHX=0
FOR
SET AMHX=$ORDER(^AUPNVMSR("AD",AMHVDLT,AMHX))
IF AMHX'=+AMHX
QUIT
SET DA=AMHX
SET DIK="^AUPNVMSR("
DO ^DIK
KILL DA,DR,DIK
+11 ;D ^APCDVDLT
+12 SET AUPNVSIT=AMHVDLT
DO MOD^AUPNVSIT
KILL AUPNVSIT
+13 IF '$PIECE(^AUPNVSIT(AMHVDLT,0),U,9)
SET APCDVDLT=$GET(AMHVDLT)
DO ^APCDVDLT
+14 QUIT
KILL ;
+1 KILL APCDALVR,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDCLN,APCDTPRO,APCDTPS,APCDTPOV,APCDTNQ,APCDTTOP,APCDTLOU,APCDTPRV,APCDTAT,APCDATMP,APCDAFLG,APCDAUTO,APCDANE,AUPNTALK,APCDAPPT,APCDOLOC
+2 QUIT
GETTYPE ;get type of visit - use loc current type or affiliation of provider
+1 SET APCDALVR("APCDTYPE")=$SELECT($PIECE($GET(^AMHSITE(DUZ(2),0)),U,2)]"":$PIECE(^(0),U,2),1:"")
IF APCDALVR("APCDTYPE")]""
QUIT
+2 ;S X=$P(^AUTTLOC($P(AMHR0,U,4),0),U,25) I X]"" S APCDALVR("APCDTYPE")=$S(X=1:"I",X=2:"6",X=3:"C",X=4:"U",X=5:"S",X=6:"T",1:"O") Q
+3 ;use pcc master control for site of loc of enc ihs/tucson/lab 11/30/95 patch 1
SET X=$PIECE($GET(^APCCCTRL($PIECE(AMHR0,U,4),0)),U,4)
IF X]""
SET APCDALVR("APCDTYPE")=X
QUIT
+4 SET X=$$PPAFFL^AMHUTIL(AMHR,"I")
IF X
SET APCDALVR("APCDTYPE")=$SELECT(X=1:"I",X=2:"C",X=3:"T",X=8:"6",1:"")
IF APCDALVR("APCDTYPE")]""
QUIT
+5 ;use pcc master control
SET X=$PIECE($GET(^APCCCTRL(DUZ(2),0)),U,4)
IF X]""
SET APCDALVR("APCDTYPE")=X
QUIT
+6 ;default to I if can't determine
SET APCDALVR("APCDTYPE")="I"
+7 QUIT
XIT ;CLEAN UP AND EXIT
+1 DO KILL
+2 LOCK -^AMHREC(AMHR,0)
+3 KILL AMHA,AMHACTN,APCDVDLT,AMHERROR,AMHBN,AMHHOLDC,AMHVFILE,AMHX,X,Y,DIE,DA,DIU,DIV,DIW,DR,APCDALVR,AMHDUZ,AMHVSIT,AMHR0,AMHLOOK,AMHGOT,AMHVISIT,AMHCOM,AMHP,AMHRES
+4 DO ^XBFMK
+5 QUIT
V2 SET AMHERROR="inability to create visit"
GOTO LBULL
V3 SET AMHERROR="invalid visit parameters (date, location etc.)"
GOTO LBULL
V9 SET AMHERROR="unable to modify visit entry "_AMHVSIT
GOTO LBULL
+1 ;
E1 SET AMHERROR="incorrect template specification"
GOTO LBULL
E2 SET AMHERROR="invalid values being passed to "_AMHVFILE
GOTO LBULL
+1 ;
LBULL ; SEND BULLETIN - LINK FAILURE
+1 KILL XMB
+2 SET XMB(1)=AMHR
SET XMB(2)=$PIECE(^DPT($PIECE(AMHR0,U,8),0),U)_" (DFN "_$PIECE(AMHR0,U,8)_")"
SET Y=$PIECE(AMHR0,U)
DO DD^%DT
SET XMB(3)=Y
SET XMB(4)=AMHERROR
SET XMB(5)=$GET(AMHVFILE)
SET XMB="AMH PCC LINK FAIL "_AMHBN
+3 DO ^XMB
KILL XMB,AMHERROR,AMHBN,AMHVFILE
+4 QUIT
BSD ;
+1 ;if non-interactive use APCDAPI4 and always force an add
+2 ;in interative mode display to user for selection
+3 ;clean out array
KILL AMHIN,AMHHOLDC
+4 DO KILL
+5 IF '$PIECE($GET(^AMHSITE(DUZ(2),0)),U,33)
SET AMHIN("FORCE ADD")=1
+6 IF $DATA(ZTQUEUED)
SET AMHIN("FORCE ADD")=1
+7 SET AMHIN("VISIT DATE")=$PIECE(AMHR0,U)
+8 DO GETTYPE
+9 SET AMHIN("VISIT TYPE")=APCDALVR("APCDTYPE")
+10 SET AMHIN("PAT")=$PIECE(AMHR0,U,8)
+11 SET AMHIN("SITE")=$PIECE(AMHR0,U,4)
+12 ;determine service category based on type of contact
+13 SET AMHIN("SRV CAT")=$PIECE(^AMHTSET($PIECE(AMHR0,U,7),0),U,3)
+14 DO GETCLN
+15 SET AMHHOLDC=$GET(APCDALVR("APCDCLN"))
+16 ;I APCDALVR("APCDCLN")]"" S AMHIN("CLINIC CODE")=APCDALVR("APCDCLN")
+17 SET AMHIN("APCDAPPT")=$PIECE(AMHR0,U,11)
+18 SET AMHIN("APCDOLOC")=$PIECE(AMHR0,U,26)
+19 SET AMHIN("APCDEVM")=$PIECE(AMHR0,U,29)
+20 SET AMHIN("APCDOPT")=$PIECE($GET(XQY0),U)
IF AMHIN("APCDOPT")]""
SET AMHIN("APCDOPT")=$ORDER(^DIC(19,"B",AMHIN("APCDOPT"),0))
+21 ;S AMHIN("PROVIDER")=$$PPINT^AMHUTIL(AMHR)
+22 SET AMHIN("APCDCAF")=$SELECT($PIECE($GET(^AMHSITE(DUZ(2),18)),U,8):"I",1:"R")
+23 SET AMHIN("TIME RANGE")=-1
+24 SET AMHIN("USR")=DUZ
+25 SET AMHIN("HOS LOC")=$$VALI^XBDIQ1(9002011,AMHR,1117)
BSDADD1 ;
+1 KILL APCDALVR
+2 KILL AMHV
+3 DO GETVISIT^APCDAPI4(.AMHIN,.AMHV)
+4 SET AMHERR=$PIECE(AMHV(0),U,2)
+5 ;errored
IF AMHERR]""
QUIT
+6 IF $PIECE(AMHV(0),U)=1
SET V=$ORDER(AMHV(0))
IF AMHV(V)="ADD"
SET AMHVSIT=V
DO SETCLN
QUIT
+7 ;since more than one passed back display them to the user and quit
SELECT ; SELECT EXISTING VISIT
+1 WRITE !!,"PATIENT: ",$PIECE(^DPT($PIECE(AMHR0,U,8),0),U)," has one or more VISITs on ",$$FMTE^XLFDT($PIECE(AMHR0,U)),".",!,"If one of these is your visit, please select it",!
+2 KILL AMHV1
SET (AMHC,AMHA,AMHX)=""
SET AMHV1=0
FOR
SET AMHV1=$ORDER(AMHV(AMHV1))
IF AMHV1'=+AMHV1
QUIT
SET AMHX=$GET(^AUPNVSIT(AMHV1,0))
SET AMHX11=$GET(^AUPNVSIT(AMHV1,11))
DO WRITE
+3 SET AMHC=AMHC+1
WRITE !,AMHC," Create New Visit",!
+4 KILL DIR
+5 SET DIR(0)="N^1:"_AMHC
SET DIR("A")="Select"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
SET AMHIN("FORCE ADD")=1
SET AMHIN("CLINIC CODE")=AMHHOLDC
GOTO BSDADD1
+7 IF AMHC=Y
SET AMHIN("FORCE ADD")=1
SET AMHIN("CLINIC CODE")=AMHHOLDC
GOTO BSDADD1
+8 SET AMHVSIT=AMHX1(Y)
+9 KILL AMHIN,APCDALVR
+10 QUIT
+11 ;
WRITE ; WRITE VISITS FOR SELECT
+1 SET AMHC=AMHC+1
SET AMHX1(AMHC)=AMHV1
+2 SET AMHVLT=$PIECE(+AMHX,".",2)
SET AMHVLT=$SELECT(AMHVLT="":"<NONE>",$LENGTH(AMHVLT)=1:AMHVLT_"0:00 ",1:$EXTRACT(AMHVLT,1,2)_":"_$EXTRACT(AMHVLT,3,4)_$EXTRACT("00",1,2-$LENGTH($EXTRACT(AMHVLT,3,4)))_" ")
+3 SET AMHVLOC=""
+4 IF $PIECE(AMHX,U,6)
IF $DATA(^AUTTLOC($PIECE(AMHX,U,6),0))
SET AMHVLOC=$PIECE(^(0),U,7)
SET AMHVLOC=AMHVLOC_$EXTRACT(" ",1,4-$LENGTH(AMHVLOC))
+5 IF AMHVLOC=""
SET AMHVLOC="...."
+6 WRITE !,AMHC," TIME: ",AMHVLT,"LOC: ",AMHVLOC," TYPE: ",$PIECE(AMHX,U,3)," CAT: ",$PIECE(AMHX,U,7)," CLINIC: ",$SELECT($PIECE(AMHX,U,8)]"":$EXTRACT($PIECE(^DIC(40.7,$PIECE(AMHX,U,8),0),U),1,8),1:"<NONE>")
Begin DoDot:1
+7 WRITE ?57,"DEC: ",$SELECT($PIECE(AMHX,U,9):$PIECE(AMHX,U,9),1:0),$SELECT($PIECE(AMHX11,U,3)]"":" VCN:"_$PIECE(AMHX11,U,3),1:"")
+8 IF $PIECE(AMHX,U,22)
WRITE !?3,"Hospital Location: ",$PIECE($GET(^SC($PIECE(AMHX,U,22),0)),U)
+9 SET AMHTIU=$$PRIMPROV^APCLV(AMHV1,"N")
IF AMHTIU]""
WRITE !?3,"Provider on Visit: ",AMHTIU
+10 SET AMHTIU=$ORDER(^AUPNVNOT("AD",AMHV1,0))
IF AMHTIU
WRITE !?3,"TIU Note: ",$$VAL^XBDIQ1(9000010.28,AMHTIU,.01)," AUTHOR: ",$$VAL^XBDIQ1(9000010.28,AMHTIU,1202)
+11 SET AMHTIU=$$PRIMPOV^APCLV(AMHV1,"C")
WRITE !?3,"Primary POV: ",AMHTIU," Narrative: ",$EXTRACT($$PRIMPOV^APCLV(AMHV1,"N"),1,40)
End DoDot:1
+12 KILL AMHVLT,AMHVLOC,AMHTIU
+13 QUIT
MRG ;EP
+1 SET DA=$ORDER(^AMHREC("AVISIT",APCDVMF,0))
+2 IF DA
SET DIE="^AMHREC("
SET DR=".16////"_APCDVMT
DO ^DIE
KILL DIE,DA,DR
+3 QUIT
DEL ;EP
+1 SET DA=$ORDER(^AMHREC("AVISIT",APCDVDLT,0))
+2 IF DA
IF $PIECE($GET(^AMHREC(DA,11)),U,10)
SET AMHRDEL=DA
DO EN^AMHLEDEL
QUIT
+3 IF DA
SET DIE="^AMHREC("
SET DR=".16///@"
DO ^DIE
KILL DIE,DA
+4 QUIT
SETCLN ;
+1 NEW DA,DIE,DR
+2 SET DA=AMHVSIT
SET DIE="^AUPNVSIT("
SET DR=".08////"_AMHHOLDC
+3 DO ^DIE
+4 QUIT
