Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AMHPCCL

AMHPCCL.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;AMHR=BH RECORD NUMBER
  1.  ;AMHACTN=ACTION TO BE TAKEN
  1.  ;
  1. START ;EP - ENTRY POINT BY TASKMAN
  1.  Q:$P($G(^AMHREC(AMHR,11)),U,10)
  1.  NEW P,X
  1.  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
  1.  I '$D(ZTQUEUED) W:'$D(AMHBL) !!,"Generating PCC Visit.",!
  1.  LOCK +^AMHREC(AMHR,0):10 E  Q    ;lock AMH record
  1.  I AMHACTN'=4 S AMHR0=^AMHREC(AMHR,0)
  1.  D @AMHACTN
  1.  D XIT
  1.  Q
  1. 1 ;add a visit
  1.  I '$D(^AMHREC(AMHR)) Q
  1. ADD1 ;
  1.  S AMHERR=""
  1.  I $G(AMHGUIV) S AMHVSIT=AMHGUIV G VF
  1.  I $L($T(^APCDAPI4)),$L($T(GETVISIT^BSDAPI4)) D  Q
  1.  .D BSD I AMHERR]"" W:'$G(AMHBL) !!,"PCC Visit not created, notify supervisor",!,"PCC visit creation error: ",AMHERR D:'$G(AMHBL) PAUSE^AMHLEA Q
  1.  .I '$G(AMHVSIT) W:'$G(AMHBL) !!,"Visit not created...notify supervisor." Q
  1.  .D VF
  1.  .Q
  1.  D SETVISIT
  1.  D ^APCDALV
  1.  I $G(APCDALVR("APCDAFLG"))=1,'$G(AMHBL) W !!,"PCC Visit not created, try again." G ADD1
  1.  I $D(APCDALVR("APCDAFLG")) S AMHBN="VISIT" D @("V"_APCDALVR("APCDAFLG")) Q
  1.  S AMHVSIT=APCDALVR("APCDVSIT")
  1. VF ;
  1.  K DR,DA,DIE S DA=AMHR,DIE="^AMHREC(",DR=".16////"_AMHVSIT_";1111////1" D CALLDIE^AMHLEIN
  1.  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
  1.  I $P($G(^AMHSITE(DUZ(2),18)),U,8) K DR,DA,DIE S DA=AMHVSIT,DIE="^AUPNVSIT(",DR="1111///I" D CALLDIE^AMHLEIN
  1.  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
  1.  D VFILES^AMHPCCL1
  1.  ;NO ERROR CHECK ABOVE !!
  1.  Q
  1. 2 ;EDIT A VISIT (DELETE AND ADD V FILES)
  1.  I '$D(^AMHREC(AMHR)) Q  ;huh  - no record to use for edit
  1.  ;set up APCDALVR vars for VISIT, call to modify 
  1.  ;if visit date/time changed, call APCDCVDT
  1.  ;then delete all V POVS, vproviders and vactivity times.
  1.  ;d VFILES^AMHPCCL1
  1.  S AMHVSIT=$P(AMHR0,U,16) ;get existing pcc visit
  1.  I AMHVSIT="" D 1 Q  ;says to edit, but no visit created, so go do add and quit
  1.  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
  1.  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
  1.  D SETVISIT
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010 (MOD)]"
  1.  S APCDALVR("APCDVSIT")=AMHVSIT
  1.  S APCDALVR("APCDLOC")="`"_APCDALVR("APCDLOC")
  1.  S APCDALVR("APCDHL")=$$VALI^XBDIQ1(9002011,AMHR,1117)  ;IHS/CMI/LAB PATCH 8 HOSP LOC
  1.  D ^APCDALVR ;edit existing visit entry
  1.  I $D(APCDALVR("APCDAFLG")) S AMHBN="VISIT" D V9 Q
  1.  I $P(^AUPNVSIT(AMHVSIT,0),U)'=$P(AMHR0,U) D
  1.  .S APCDCVDT("VISIT DFN")=AMHVSIT
  1.  .S APCDCVDT("VISIT DATE/TIME")=$P(AMHR0,U)_$S($P($P(AMHR0,U),".",2)]"":"",1:".12")
  1.  .S APCDCVDT("TALK")=1
  1.  .D ^APCDCVDT
  1.  .I $D(APCDCVDT("ERROR FLAG")) W !!,$C(7),$C(7),"Error changing PCC Visit Date and Time...PLEASE NOTIFY SITE MANAGER",! H 5
  1.  .K APCDCVDT
  1.  .Q
  1.  ;delete all providers
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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
  1.  D VFILES^AMHPCCL1
  1.  Q
  1. 3 ;APPEND
  1.  I '$D(^AMHREC(AMHR)) Q  ;huh  - no record to use for edit
  1.  S AMHVSIT=$P(AMHR0,U,16) ;get existing pcc visit
  1.  I AMHVSIT="" D 1 Q  ;says to append, but no visit created, so go do add and quit
  1.  ;delete all providers
  1.  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
  1.  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
  1.  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
  1.  D VFILES^AMHPCCL1
  1.  Q
  1. SETVISIT ;set up visit values
  1.  D KILL
  1.  S APCDALVR("AUPNTALK")=""
  1.  S APCDALVR("APCDDATE")=$P(AMHR0,U)
  1.  D GETTYPE
  1.  S APCDALVR("APCDPAT")=$P(AMHR0,U,8)
  1.  S APCDALVR("APCDLOC")=$P(AMHR0,U,4)
  1.  ;determine service category based on type of contact
  1.  S APCDALVR("APCDCAT")=$P(^AMHTSET($P(AMHR0,U,7),0),U,3)
  1.  I '$P($G(^AMHSITE(DUZ(2),0)),U,33) S APCDALVR("APCDAUTO")=""
  1.  I $D(ZTQUEUED) S APCDALVR("APCDAUTO")=""
  1.  S APCDALVR("APCDANE")=""
  1.  ;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
  1.  I '$P($G(^AMHSITE(DUZ(2),0)),U,33) S APCDALVR("APCDADD")=1
  1.  I $D(ZTQUEUED) S APCDALVR("APCDADD")=1
  1.  D GETCLN
  1.  I APCDALVR("APCDCAT")="I" S APCDALVR("APCDCLN")=""  ;PER LESLIE RACINE
  1.  I APCDALVR("APCDCLN")]"" S APCDALVR("APCDCLN")="`"_APCDALVR("APCDCLN")
  1.  S APCDALVR("APCDAPPT")=$P(AMHR0,U,11)
  1.  S APCDALVR("APCDOLOC")=$P(AMHR0,U,26)
  1.  S APCDALVR("APCDEVM")=$P(AMHR0,U,29)
  1.  S APCDALVR("APCDHL")=$$VALI^XBDIQ1(9002011,AMHR,1117)  ;IHS/CMI/LAB PATCH 8 HOSP LOC
  1.  Q
  1. GETCLN ;determine clinic to pass
  1.  S APCDALVR("APCDCLN")=""
  1.  NEW X
  1.  S X=$P(AMHR0,U,7)
  1.  I X="" G GETCLN1
  1.  I $P($G(^AMHTSET(X,0)),U,2)=9 S APCDALVR("APCDCLN")=$O(^DIC(40.7,"C",30,"")) Q:APCDALVR("APCDCLN")]""
  1.  I $P($G(^AMHTSET(X,0)),U,2)=5 S APCDALVR("APCDCLN")=$O(^DIC(40.7,"C",11,"")) Q:APCDALVR("APCDCLN")]""
  1. GETCLN1 ;
  1.  S APCDALVR("APCDCLN")=$P(AMHR0,U,25)
  1.  Q:APCDALVR("APCDCLN")]""
  1.  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,"")))
  1.  I APCDALVR("APCDCLN")="" S APCDALVR("APCDCLN")=$O(^DIC(40.7,"C",25,""))
  1.  Q
  1. 4 ;delete visit in PCC
  1.  W !,"Deleting associated PCC Visit.",!
  1.  S APCDVDLT=$G(AMHVDLT) I APCDVDLT="" Q
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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
  1.  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
  1.  ;D ^APCDVDLT
  1.  S AUPNVSIT=AMHVDLT D MOD^AUPNVSIT K AUPNVSIT
  1.  I '$P(^AUPNVSIT(AMHVDLT,0),U,9) S APCDVDLT=$G(AMHVDLT) D ^APCDVDLT
  1.  Q
  1. KILL ;
  1.  K APCDALVR,APCDPAT,APCDLOC,APCDTYPE,APCDCAT,APCDCLN,APCDTPRO,APCDTPS,APCDTPOV,APCDTNQ,APCDTTOP,APCDTLOU,APCDTPRV,APCDTAT,APCDATMP,APCDAFLG,APCDAUTO,APCDANE,AUPNTALK,APCDAPPT,APCDOLOC
  1.  Q
  1. GETTYPE ;get type of visit - use loc current type or affiliation of provider
  1.  S APCDALVR("APCDTYPE")=$S($P($G(^AMHSITE(DUZ(2),0)),U,2)]"":$P(^(0),U,2),1:"") Q:APCDALVR("APCDTYPE")]""
  1.  ;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
  1.  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
  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
  1.  S X=$P($G(^APCCCTRL(DUZ(2),0)),U,4) I X]"" S APCDALVR("APCDTYPE")=X Q  ;use pcc master control
  1.  S APCDALVR("APCDTYPE")="I" ;default to I if can't determine
  1.  Q
  1. XIT ;CLEAN UP AND EXIT
  1.  D KILL
  1.  LOCK -^AMHREC(AMHR,0)
  1.  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
  1.  D ^XBFMK
  1.  Q
  1. V2 S AMHERROR="inability to create visit" G LBULL
  1. V3 S AMHERROR="invalid visit parameters (date, location etc.)" G LBULL
  1. V9 S AMHERROR="unable to modify visit entry "_AMHVSIT G LBULL
  1.  ;
  1. E1 S AMHERROR="incorrect template specification" G LBULL
  1. E2 S AMHERROR="invalid values being passed to "_AMHVFILE G LBULL
  1.  ;
  1. LBULL ; SEND BULLETIN - LINK FAILURE
  1.  K XMB
  1.  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
  1.  D ^XMB K XMB,AMHERROR,AMHBN,AMHVFILE
  1.  Q
  1. BSD ;
  1.  ;if non-interactive use APCDAPI4 and always force an add
  1.  ;in interative mode display to user for selection
  1.  K AMHIN,AMHHOLDC ;clean out array
  1.  D KILL
  1.  I '$P($G(^AMHSITE(DUZ(2),0)),U,33) S AMHIN("FORCE ADD")=1
  1.  I $D(ZTQUEUED) S AMHIN("FORCE ADD")=1
  1.  S AMHIN("VISIT DATE")=$P(AMHR0,U)
  1.  D GETTYPE
  1.  S AMHIN("VISIT TYPE")=APCDALVR("APCDTYPE")
  1.  S AMHIN("PAT")=$P(AMHR0,U,8)
  1.  S AMHIN("SITE")=$P(AMHR0,U,4)
  1.  ;determine service category based on type of contact
  1.  S AMHIN("SRV CAT")=$P(^AMHTSET($P(AMHR0,U,7),0),U,3)
  1.  D GETCLN
  1.  S AMHHOLDC=$G(APCDALVR("APCDCLN"))
  1.  ;I APCDALVR("APCDCLN")]"" S AMHIN("CLINIC CODE")=APCDALVR("APCDCLN")
  1.  S AMHIN("APCDAPPT")=$P(AMHR0,U,11)
  1.  S AMHIN("APCDOLOC")=$P(AMHR0,U,26)
  1.  S AMHIN("APCDEVM")=$P(AMHR0,U,29)
  1.  S AMHIN("APCDOPT")=$P($G(XQY0),U) I AMHIN("APCDOPT")]"" S AMHIN("APCDOPT")=$O(^DIC(19,"B",AMHIN("APCDOPT"),0))
  1.  ;S AMHIN("PROVIDER")=$$PPINT^AMHUTIL(AMHR)
  1.  S AMHIN("APCDCAF")=$S($P($G(^AMHSITE(DUZ(2),18)),U,8):"I",1:"R")
  1.  S AMHIN("TIME RANGE")=-1
  1.  S AMHIN("USR")=DUZ
  1.  S AMHIN("HOS LOC")=$$VALI^XBDIQ1(9002011,AMHR,1117)
  1. BSDADD1 ;
  1.  K APCDALVR
  1.  K AMHV
  1.  D GETVISIT^APCDAPI4(.AMHIN,.AMHV)
  1.  S AMHERR=$P(AMHV(0),U,2)
  1.  I AMHERR]"" Q  ;errored
  1.  I $P(AMHV(0),U)=1 S V=$O(AMHV(0)) I AMHV(V)="ADD" S AMHVSIT=V D SETCLN Q
  1.  ;since more than one passed back display them to the user and quit
  1. SELECT ; SELECT EXISTING VISIT
  1.  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",!
  1.  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
  1.  S AMHC=AMHC+1 W !,AMHC,"  Create New Visit",!
  1.  K DIR
  1.  S DIR(0)="N^1:"_AMHC,DIR("A")="Select" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) S AMHIN("FORCE ADD")=1 S AMHIN("CLINIC CODE")=AMHHOLDC G BSDADD1
  1.  I AMHC=Y S AMHIN("FORCE ADD")=1 S AMHIN("CLINIC CODE")=AMHHOLDC G BSDADD1
  1.  S AMHVSIT=AMHX1(Y)
  1.  K AMHIN,APCDALVR
  1.  Q
  1.  ;
  1. WRITE ; WRITE VISITS FOR SELECT
  1.  S AMHC=AMHC+1,AMHX1(AMHC)=AMHV1
  1.  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)))_" ")
  1.  S AMHVLOC=""
  1.  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))
  1.  S:AMHVLOC="" AMHVLOC="...."
  1.  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
  1.  .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:"")
  1.  .I $P(AMHX,U,22) W !?3,"Hospital Location: ",$P($G(^SC($P(AMHX,U,22),0)),U)
  1.  .S AMHTIU=$$PRIMPROV^APCLV(AMHV1,"N") I AMHTIU]"" W !?3,"Provider on Visit: ",AMHTIU
  1.  .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)
  1.  .S AMHTIU=$$PRIMPOV^APCLV(AMHV1,"C") W !?3,"Primary POV: ",AMHTIU,"  Narrative: ",$E($$PRIMPOV^APCLV(AMHV1,"N"),1,40)
  1.  K AMHVLT,AMHVLOC,AMHTIU
  1.  Q
  1. MRG ;EP
  1.  S DA=$O(^AMHREC("AVISIT",APCDVMF,0))
  1.  I DA S DIE="^AMHREC(",DR=".16////"_APCDVMT D ^DIE K DIE,DA,DR
  1.  Q
  1. DEL ;EP
  1.  S DA=$O(^AMHREC("AVISIT",APCDVDLT,0))
  1.  I DA,$P($G(^AMHREC(DA,11)),U,10) S AMHRDEL=DA D EN^AMHLEDEL Q
  1.  I DA S DIE="^AMHREC(",DR=".16///@" D ^DIE K DIE,DA
  1.  Q
  1. SETCLN ;
  1.  NEW DA,DIE,DR
  1.  S DA=AMHVSIT,DIE="^AUPNVSIT(",DR=".08////"_AMHHOLDC
  1.  D ^DIE
  1.  Q