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

AMHEGR.m

Go to the documentation of this file. 
  1. AMHEGR ; IHS/CMI/LAB - GROUP ENTRY ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**2,4,5,8**;JUN 02, 2010;Build 7
  1.  ;
  1.  ;
  1. START ;
  1.  W:$D(IOF) @IOF
  1.  D DONE
  1.  ;
  1. DATES ;
  1.  K AMHRED,AMHRBD
  1.  W !,"Please enter the date range for displaying Group definitions."
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Date"
  1.  D ^DIR Q:Y<1  S AMHRBD=Y
  1.  K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Date"
  1.  D ^DIR Q:Y<1  S AMHRED=Y
  1.  ;
  1.  I AMHRED<AMHRBD D  G DATES
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  ;
  1.  D EN,FULL^VALM1
  1.  D DONE
  1.  Q
  1. DONE ;
  1.  D EN^XBVK("AMH")
  1.  D ^XBFMK
  1.  D KILL^AUPNPAT
  1.  Q
  1. EN ;
  1.  K ^TMP($J,"AMHEGR")
  1.  D ^AMHLEIN
  1.  D GATHER
  1.  D EN^VALM("AMH GROUP ENTRY")
  1.  D CLEAR^VALM1
  1.  Q
  1. GATHER ;
  1.  D GATHER^AMHEGR1
  1.  Q
  1. CTR(X,Y) ;EP - Center
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. HDR ; -- header code
  1.  S VALMHDR(1)="Group Entry             * - Unsigned Group Note"
  1.  S X="",$E(X,7)="Date",$E(X,16)="Group Name",$E(X,37)="Activity",$E(X,48)="Prg",$E(X,52)="Cln",$E(X,59)="Prov",$E(X,69)="TOC",$E(X,73)="POV"
  1.  S VALMHDR(2)=X
  1.  Q
  1.  ;
  1. INIT ;
  1.  D GATHER
  1.  S VALMCNT=AMHLINE
  1.  Q
  1.  ;
  1. HELP ;
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1. REV ;
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) W !,"No records selected." D EXIT Q
  1.  S R=$O(VALMY(0)) I 'R K R,VALMY,XQORNOD W !,"No record selected." D EXIT Q
  1.  S AMHNG=0 S AMHNG=^TMP($J,"AMHEGR","IDX",R,R)
  1.  I '$D(^AMHGROUP(AMHNG,0)) W !,"Not a valid GROUP." K AMHNG,R,AMHG,R1 D PAUSE D EXIT Q
  1.  D FULL^VALM1
  1.  I $P(^AMHGROUP(AMHNG,0),U,18) W !!,"The notes associated with this group entry have been signed. ",!,"You can edit other items in this entry but not the notes." D PAUSE
  1.  NEW P,X,G,A,R
  1.  K A
  1.  S P=0 F  S P=$O(^AMHGROUP(AMHNG,61,P)) Q:P'=+P  S R=$P(^AMHGROUP(AMHNG,61,P,0),U,1) S X=$P($G(^AMHREC(R,0)),U,8) S A(X)=""
  1.  S P=0,G=0 F  S P=$O(^AMHGROUP(AMHNG,51,P)) Q:P'=+P  S X=$P(^AMHGROUP(AMHNG,51,P,0),U) D
  1.  .I '$D(A(X)) S G=1
  1.  I G W !!,"All of the visits have not been entered for this group.  Use Sign Note or ","Edit Group Definition to add visits.",! D PAUSE,EXIT Q
  1.  D ^AMHEGS
  1.  D EXIT
  1.  Q
  1. EDITDEF ;
  1.  D FULL^VALM1
  1.  W !!,"This action should be used to edit a group definition only.  If visits have"
  1.  W !,"already been entered for this group, you will not be able to edit the group"
  1.  W !,"definition.",!
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) W !,"No records selected." D EXIT Q
  1.  S R=$O(VALMY(0)) I 'R K R,VALMY,XQORNOD W !,"No record selected." D EXIT Q
  1.  S AMHNG=0 S AMHNG=^TMP($J,"AMHEGR","IDX",R,R)
  1.  I '$D(^AMHGROUP(AMHNG,0)) W !,"Not a valid GROUP." K AMHNG,R,AMHG,R1 D PAUSE D EXIT Q
  1.  D FULL^VALM1
  1.  I $O(^AMHGROUP(AMHNG,61,0)) W !!,"This group already has visits created.  You must use the REVIEW/EDIT",!,"GROUP VISITS to modify visits within this group." D PAUSE,EXIT Q
  1.  I $P(^AMHGROUP(AMHNG,0),U,18) W !!,"This Group's Notes have been signed.  You cannot edit the Group.",! D PAUSE,EXIT Q
  1.  S AMHDATE=$P($P(^AMHGROUP(AMHNG,0),U),".")
  1.  D EDITGRP
  1.  Q
  1. ADDGRP ;
  1.  D FULL^VALM1
  1.  ;add new group 
  1.  K DIR S DIR(0)="D^:"_DT_":EP",DIR("A")="Enter Date of the Group Activity" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !,"date not entered." D PAUSE,EXIT Q
  1.  S AMHDATE=Y
  1.  S X=AMHDATE,DIC="^AMHGROUP(",DLAYGO=9002011.67,DIADD=1,DIC(0)="L" K DD,DO D FILE^DICN
  1.  I Y=-1 W !!,"entry of new group failed." K DIADD,DLAYGO D ^XBFMK D EXIT Q
  1.  S AMHNG=+Y
  1.  K DIADD,DLAYGO D ^XBFMK
  1. EDITGRP ;EP
  1.  S APCDOVRR=1
  1.  S DA=AMHNG,DDSFILE=9002011.67,DR="[AMH GROUP ADD/EDIT]" D ^DDS
  1.  I $D(DIMSG) W !!,"ERROR IN SCREENMAN FORM!!  ***NOTIFY PROGRAMMER***" S AMHQUIT=1 K DIMSG D PAUSE,EXIT Q
  1.  ;must have a pov/provider
  1.  S E=0
  1.  I '$O(^AMHGROUP(AMHNG,11,0)) W !!,"Group must have at least one Provider defined." S E=1
  1.  NEW X,G,C
  1.  S X=0,G=0,C=0 F  S X=$O(^AMHGROUP(AMHNG,11,X)) Q:X'=+X  I $P($G(^AMHGROUP(AMHNG,11,X,0)),U,2)="P" S G=1,C=C+1
  1.  I C>1 W !!,"Group must not have 2 PRIMARY PROVIDER's defined." S E=1
  1.  I 'G W !!,"Group must have at least one PRIMARY PROVIDER defined." S E=1
  1.  I '$O(^AMHGROUP(AMHNG,21,0)) W !!,"Group must have at least one POV defined." S E=1
  1.  I '$O(^AMHGROUP(AMHNG,51,0)) W !!,"Group must have at least one Patient defined." S E=1
  1.  S X=0,G=0 F  S X=$O(^AMHGROUP(AMHNG,31,X)) Q:X'=+X  I $G(^AMHGROUP(AMHNG,31,X,0))]"" S G=1
  1.  I 'G W !!,"Group must have a group narrative defined.  " S E=1
  1.  I E S AMHE="" D  G:AMHE="E" EDITGRP D:AMHE="Q" PAUSE,EXIT Q:AMHE="Q"  W !!,"deleting group definition." S DA=AMHNG,DIK="^AMHGROUP(" D ^DIK D PAUSE,EXIT Q
  1.  .S DIR(0)="S^E:Edit the Group definition;D:Delete this Group definition;Q:to exit and edit it later without deleting the group definition",DIR("A")="This group definition is not complete, do you wish to",DIR("B")="E" KILL DA D ^DIR KILL DIR
  1.  .I $D(DIRUT) Q
  1.  .S AMHE=Y
  1.  .Q
  1.  ;now loop through patients and add records
  1.  D ^XBFMK
  1.  W !!,"You have added the following group definition, please review it carefully",!,"before you proceed.",!
  1.  S DA=AMHNG,DIC="^AMHGROUP(" D EN^DIQ
  1.  S DIR(0)="S^Y:Yes, group definition is accurate, continue on to add visits;N:No, I wish to edit the group definition;Q:I wish to QUIT and exit",DIR("A")="Do you wish to continue on to add patient visits for this group"
  1.  S DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D PAUSE,EXIT Q
  1.  I Y="Q" D PAUSE,EXIT Q
  1.  I Y="N" G EDITGRP
  1. SENS ;check for sensitive patients
  1.  S AMHQ=0
  1.  NEW AMHRESU
  1.  S AMHX=0 F  S AMHX=$O(^AMHGROUP(AMHNG,51,AMHX)) Q:AMHX'=+AMHX!(AMHQ)  D
  1.  .S AMHPAT=$P(^AMHGROUP(AMHNG,51,AMHX,0),U,1)
  1.  .K AMHRESU
  1.  .D PTSEC^AMHUTIL2(.AMHRESU,AMHPAT,1)
  1.  .I '$G(AMHRESU(1)) Q
  1.  .I $G(AMHRESU(1))=3!($G(AMHRESU(1))=4)!($G(AMHRESU(1))=5) D DISPDG^AMHLE S AMHQ=1 Q
  1.  .D DISPDG^AMHEGS
  1.  .W ! K DIR S DIR(0)="Y",DIR("A")="Do you want to continue to add visits for this group",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  .I 'Y S AMHQ=1 Q
  1.  .K AMHRESU
  1.  .D NOTICE^DGSEC4(.AMHRESU,AMHPAT,,3)
  1.  K AMHPAT
  1.  W !!!
  1.  I AMHQ D  D EXIT Q
  1.  .W !!,"You have selected not to continue and add visits for a patient in this group."
  1.  .W !,"You must go back and remove the patient from the group definition before "
  1.  .W !,"you can continue on to add the visits for the group.",!!!!
  1.  .D PAUSE^AMHLEA
  1.  D ADDREC
  1.  D EXIT
  1.  Q
  1. DUP ;EP -
  1.  D DUP^AMHEGR1
  1.  Q
  1. DISP ;EP - called from protocol
  1.  D DISP^AMHEGR1
  1.  Q
  1. PRTEF ;EP
  1.  D PRTEF^AMHEGR1
  1.  Q
  1. DEL ;EP - called from protocol
  1.  D DEL^AMHEGR1
  1.  Q
  1. ADDREC ;EP
  1.  D FULL^VALM1
  1.  K DIR
  1.  W !!,"Adding records for each individual patient in this group.",!
  1.  K AMHDELQ S AMHNGX=0 F  S AMHNGX=$O(^AMHGROUP(AMHNG,51,AMHNGX)) Q:AMHNGX'=+AMHNGX!($G(AMHDELQ))  D ADDREC1
  1. SIGN ;EP
  1.  S AMHSIGN=0
  1.  S P=$$PP(AMHNG)
  1.  I $D(^AMHSITE(DUZ(2),19,"B",P)) W !!,"No E-Sig Required.  Provider opted out of E-Sig." G PCCLINK
  1.  S D=$P($P(^AMHGROUP(AMHNG,0),U),".")
  1.  I '$$ESIGREQ^AMHESIG(,D) W !!,"No E-Sig required.  Date prior to Version 4.0." G PCCLINK
  1.  I P'=DUZ W !!,"You are not the primary provider for this group, no electronic",!,"signature will be applied and no PCC link will occur.",!,"The primary provider will need to sign these at a later time." D PAUSE,EXIT Q
  1.  W !!,"You can now sign all of the progress notes for this group of visits."
  1.  D SIG^XUSESIG
  1.  I X1="" W !!,"You will need to sign them later." K X1 D PAUSE,EXIT Q
  1.  S AMHSIGN=1
  1.  D PCCLINK^AMHEGR1
  1.  K X1
  1. SIGN1 D PAUSE,EXIT
  1.  Q
  1. ADDREC1 ;EP
  1.  S (AMHPAT,DFN)=$P(^AMHGROUP(AMHNG,51,AMHNGX,0),U)
  1. ADDREC2 ;
  1.  S AMHG0=^AMHGROUP(AMHNG,0)
  1.  S APCDOVRR=1,AMHOVRR=1
  1.  S AMHVTYPE="R",AMHLOC=$P(AMHG0,U,5),AMHPROG=$P(AMHG0,U,2),AMHDATE=$P(AMHG0,U),AMHCLN=$P(AMHG0,U,14),AMHCOMM=$P(AMHG0,U,6),AMHACT=$P(AMHG0,U,7),AMHCONT=$P(AMHG0,U,8),AMHINT="",AMHPTYPE=AMHPROG,AMHCC=$G(^AMHGROUP(AMHNG,12))
  1.  S AMHTIME=$P(AMHG0,U,11)
  1.  S AMHNUM=0,X=0 F  S X=$O(^AMHGROUP(AMHNG,51,X)) Q:X'=+X  S AMHNUM=AMHNUM+1
  1.  S AMHACTP=AMHTIME\AMHNUM I AMHACTP<1 S AMHACTP=1
  1.  S AMHACTN=1
  1.  W !!,"Creating new BH record for ",$P(^DPT(AMHPAT,0),U),"."
  1.  K DD,D0,DO,DIC,DA,DR S DIC("DR")="",DIC(0)="EL",DIC="^AMHREC(",DLAYGO=9002011,DIADD=1,X=AMHDATE,DIC("DR")="1111////1" D FILE^DICN K DIC,DR,DIE,DIADD,DLAYGO,X,D0
  1.  I Y=-1 W !!,$C(7),$C(7),"Behavioral Health Record is NOT complete!!  Deleting Record.",! D PAUSE,^XBFMK Q
  1.  S (DA,AMHR)=+Y,AMHAWIXX="A",DIE="^AMHREC(",DR="[AMH ADD RECORD NO INTERACT]" D CALLDIE^AMHLEIN K AMHAWIXX
  1.  I $D(Y) D  S AMHDELQ=1 Q
  1.  .W !!,"ERROR -- Incomplete record!! You have exited before a complete record"
  1.  .W !,"had been added.  I have to delete the record.  Please complete the",!,"entry of patient visits for this group at a later time.",!!
  1.  .S AMHGRPDE=1 D DELR^AMHEGR1 K AMHGRPDE Q
  1.  S AMHVTYPE=$P(^AMHREC(AMHR,0),U,33)
  1.  K DIADD,DLAYGO
  1.  D ^XBFMK
  1.  S DIE="^AMHREC(",DA=AMHR
  1.  S DR=".09////1;.11////U;.19////"_DUZ_";.33////R;.28////"_DUZ_";.22///A;.21///^S X=DT;.25////"_$P(AMHNG,U,14)_";.34////1;.12////"_AMHACTP_";1109////"_$P(^AMHGROUP(AMHNG,0),U,3)_";1117////"_$$HL^AMHUTIL2($$VALI^XBDIQ1(9002011,AMHR,.02))
  1.  ;_";2101///"_$P($G(^AMHGROUP(AMHNG,12)),U,1)
  1.  D ^DIE
  1.  I $D(Y) W !!,"updating record for patient ",$P(^DPT(DFN,0),U)," failed." D PAUSE,EXIT Q
  1.  S DIE="^AMHREC(",DA=AMHR,DR="5100///NOW",DR(2,9002011.5101)=".02////^S X=DUZ" D ^DIE K DIE,DA,DR
  1.  I $P($G(^AMHGROUP(AMHNG,12)),U,1)]"" S $P(^AMHREC(AMHR,21),U,1)=$P(^AMHGROUP(AMHNG,12),U,1)
  1.  ;add in providers,povs,cpts,subjective
  1. ADDPRV ;
  1.  S AMHP=0 F  S AMHP=$O(^AMHGROUP(AMHNG,11,AMHP)) Q:AMHP'=+AMHP  D
  1.  .S AMHP1=$P(^AMHGROUP(AMHNG,11,AMHP,0),U)
  1.  .Q:'AMHP1
  1.  .Q:'$D(^VA(200,AMHP1,0))
  1.  .S X=AMHP1,DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04///"_$P(^AMHGROUP(AMHNG,11,AMHP,0),U,2),DIC="^AMHRPROV(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.02 K DD,DO D FILE^DICN
  1.  .K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1.  .I Y=-1 W !!,"Creating Provider entry failed!!!",$C(7),$C(7) H 2
  1. ADDPOV ;
  1.  S AMHP=0 F  S AMHP=$O(^AMHGROUP(AMHNG,21,AMHP)) Q:AMHP'=+AMHP  D
  1.  .S AMHP1=$P(^AMHGROUP(AMHNG,21,AMHP,0),U)
  1.  .Q:'AMHP1
  1.  .Q:'$D(^AMHPROB(AMHP1,0))
  1.  .S AMHNAR=$P(^AMHGROUP(AMHNG,21,AMHP,0),U,2)
  1.  .S X=AMHP1,DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04///`"_AMHNAR,DIC="^AMHRPRO(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.01 K DD,DO D FILE^DICN
  1.  .K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1.  .I Y=-1 W !!,"Creating POV entry failed!!!",$C(7),$C(7) H 2
  1.  D EP2^AMHEGRPV
  1.  I $G(AMHDELTV) D  Q
  1.  .W !!,"ERROR -- Incomplete record!! Deleting record.",!!
  1.  .S AMHGRPDE=1 D DELR^AMHEGR1 K AMHGRPDE Q
  1. ADDCPTS ;
  1.  S AMHP=0 F  S AMHP=$O(^AMHGROUP(AMHNG,41,AMHP)) Q:AMHP'=+AMHP  D
  1.  .S AMHP1=$P(^AMHGROUP(AMHNG,41,AMHP,0),U)
  1.  .Q:'AMHP1
  1.  .Q:'$D(^ICPT(AMHP1,0))
  1.  .S AMH0=^AMHGROUP(AMHNG,41,AMHP,0)
  1.  .S X=AMHP1,DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.08////"_$P(AMH0,U,3)_";.09////"_$P(AMH0,U,4)_";.16////"_$P(AMH0,U,2)
  1.  .S DIC="^AMHRPROC(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.04 K DD,DO D FILE^DICN
  1.  .K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1.  .I Y=-1 W !!,"Creating CPT entry failed!!!",$C(7),$C(7) H 2
  1. ADDPTED ;
  1.  K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1.  S AMHP=0 F  S AMHP=$O(^AMHGROUP(AMHNG,71,AMHP)) Q:AMHP'=+AMHP  D
  1.  .S AMHP1=$P(^AMHGROUP(AMHNG,71,AMHP,0),U)
  1.  .S AMHP0=^AMHGROUP(AMHNG,71,AMHP,0)
  1.  .S AMHP11=$P($G(^AMHGROUP(AMHNG,71,AMHP,11)),U)
  1.  .S AMHP12=$P($G(^AMHGROUP(AMHNG,71,AMHP,11)),U,2)
  1.  .Q:'AMHP1
  1.  .Q:'$D(^AUTTEDT(AMHP1,0))
  1.  .S X=AMHP1
  1.  .S DIC("DR")=".02////"_$G(AMHPAT)_";.03////"_AMHR_";.04///`"_$P(AMHP0,U,2)_";.05///"_$P(AMHP0,U,3)_";.06///"_$P(AMHP0,U,4)_";.07////"_$P(AMHP0,U,5)_";.08///"_$P(AMHP0,U,6)_";.09///"_$P(AMHP0,U,7)_";.11///"_$P(AMHP0,U,8)_";1102////"_AMHP12
  1.  .S DIC="^AMHREDU(",DIC(0)="MLQ",DIADD=1,DLAYGO=9002011.05 K DD,DO D FILE^DICN
  1.  .K DIC,DA,DO,DD,D0,DG,DH,DI,DIW,DIU,DIADD,DIE,DQ,DLAYGO
  1.  .I Y=-1 W !!,"Creating PT ED entry failed!!!",$C(7),$C(7) H 2
  1.  .I AMHP11]"" S $P(^AMHREDU(+Y,11),U,1)=AMHP11
  1. CC ;
  1.  W !!
  1.  S DA=AMHR,DIE="^AMHREC(",DR=2101 D ^DIE K DA,DIE,DR D ^XBFMK
  1.  W !
  1. SOAP ;put in standard soap
  1.  D SOAP^AMHEGR1
  1. MCPT ;
  1.  D EP^AMHEGRCP
  1.  D ^XBFMK
  1.  W !
  1.  S DA=AMHR,DIE="^AMHREC(",DR=".27VISIT FLAG: " D ^DIE,^XBFMK
  1.  Q
  1. PAUSE ;EP
  1.  K DIR
  1.  S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. EXIT ;EP -- exit code
  1.  D TERM^VALM0
  1.  S VALMBCK="R"
  1.  D GATHER
  1.  S VALMCNT=AMHLINE
  1.  D HDR
  1.  K X,Y,Z,I
  1.  Q
  1. NOSHOW ;EP - CALLED FROM PROTOCOL
  1.  D FULL^VALM1
  1.  W !!,"This option is used to enter a No-Show visit for a client who failed"
  1.  W !,"to show for his/her group session."
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) W !,"No records selected." D EXIT Q
  1.  S R=$O(VALMY(0)) I 'R K R,VALMY,XQORNOD W !,"No record selected." D EXIT Q
  1.  S AMHG=0 S AMHG=^TMP($J,"AMHEGR","IDX",R,R)
  1.  I '$D(^AMHGROUP(AMHG,0)) W !,"Not a valid GROUP." K AMHRDEL,R,AMHG,R1 D PAUSE,EXIT Q
  1.  S AMHDATE=$P(^AMHGROUP(AMHG,0),U)
  1.  S AMHPTYPE=$P(^AMHGROUP(AMHG,0),U,2)
  1.  S AMHVTYPE="R"
  1.  S AMHPAT=""
  1.  D GETPAT^AMHLEA
  1.  I AMHPAT="" W !!,"No patient entered" H 2 D EXIT Q
  1.  S DFN=AMHPAT
  1.  D ADDNS
  1.  K AMHPAT,DFN,AMHDATE,AMHPTYPE,AMHVTYPE
  1.  D EXIT
  1.  Q
  1. ADDNS ;EP
  1.  D ADDNS^AMHEGS
  1.  Q
  1. INTX(X) ;
  1.  I '$D(^AUPNPAT(X)) Q 0
  1.  I '$$ALLOWP^AMHUTIL(DUZ,X) D NALLOWP^AMHUTIL Q 0
  1.  NEW %,D
  1.  S %=$$DOD^AUPNPAT(X) I %="" Q 0
  1.  S D=$S($G(AMHDATE):$P(AMHDATE,"."),$G(DA(1)):$P(^AMHGROUP(DA(1),0),U,1))
  1.  I $G(D),$P(D,".")>% K X Q 0
  1.  Q 1
  1. ALIVE ;EP
  1.  I '$D(X) Q
  1.  NEW %,D
  1.  S %=$$DOD^AUPNPAT(X) I %="" Q
  1.  S D=$S($G(AMHDATE):$P(AMHDATE,"."),$G(DA(1)):$P(^AMHGROUP(DA(1),0),U,1))
  1.  I $G(D),$P(D,".")>% K X D EN^DDIOL("Patient is deceased as of the visit date.") K X Q
  1.  Q
  1. PP(G) ;EP
  1.  NEW X,Y
  1.  S Y=""
  1.  S X=0 F  S X=$O(^AMHGROUP(G,11,X)) Q:X'=+X  I $P(^AMHGROUP(G,11,X,0),U,2)="P" S Y=$P(^AMHGROUP(G,11,X,0),U,1)
  1.  Q Y