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

AMHRAS1P.m

Go to the documentation of this file.
  1. AMHRAS1P ; IHS/CMI/LAB - list refusals ;
  1. ;;4.0;IHS BEHAVIORAL HEALTH;**5**;JUN 02, 2010;Build 18
  1. ;
  1. ;
  1. PRINT ;EP - called from xbdbque
  1. D PRINT1
  1. D DONE
  1. Q
  1. PRINT1 ;
  1. S AMHRPG=0 K AMHRQUIT
  1. K AMHRLSTP
  1. I '$D(^XTMP("AMHRAS1",AMHRJ,AMHRH)) D HEADER W !!,"No data to report.",! G DONE
  1. D HEADER
  1. S AMHRTOT=$$TOT
  1. W !," Total Number of Patients screened",?40,$J($$COM(AMHRTOT,0),8)
  1. D RES
  1. Q:$$END
  1. D GENDER
  1. Q:$$END
  1. D AGE
  1. Q:$$END
  1. D PRVSC
  1. Q:$$END
  1. D PRVV
  1. Q:$$END
  1. D DESPRV
  1. Q:$$END
  1. D CLINIC
  1. Q:$$END
  1. D DATE
  1. Q:$$END
  1. D MH
  1. Q:$$END
  1. D SS
  1. Q:$$END
  1. D CD
  1. Q:$$END
  1. K ^TMP($J)
  1. I AMHRLIST D LIST
  1. Q
  1. RES ;
  1. Q:'$D(AMHRTALL(1))
  1. ;TALLY BY RESULT FIRST
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,2) S R=$P(R,";")_" "_$P(R,";",2) S:R="" R="NO RESULT RECORDED" S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Result",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .S Y=$L(AMHRX),Y=38-Y W !?Y,AMHRX,?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. Q
  1. GENDER ;
  1. Q:'$D(AMHRTALL(2))
  1. ;TALLY BY GENDER OF PATIENT
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,3) S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Gender",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L(AMHRX),Y=38-Y W !?Y,AMHRX,?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. .Q
  1. Q
  1. AGE ;
  1. Q:'$D(AMHRTALL(3))
  1. ;TALLY BY age OF PATIENT
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,4) S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Age",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L(AMHRX_" yrs"),Y=38-Y W !?Y,AMHRX," yrs",?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. Q
  1. PRVSC ;
  1. Q:'$D(AMHRTALL(4))
  1. ;TALLY BY PRIMARY provider OF service
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,5) S:R="" R="UNKNOWN" S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Provider who screened",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L(AMHRX),Y=38-Y W !?Y,AMHRX,?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. Q
  1. PRVV ;
  1. Q:'$D(AMHRTALL(7))
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,7) S:R="" R="UNKNOWN" S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Primary Provider of Visit",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L(AMHRX),Y=38-Y W !?Y,AMHRX,?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. Q
  1. DESPRV ;
  1. Q:'$D(AMHRTALL(11))
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,11) S:R="" R="UNKNOWN" S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Designated Primary Care Provider",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L(AMHRX),Y=38-Y W !?Y,AMHRX,?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. Q
  1. MH ;
  1. Q:'$D(AMHRTALL(8))
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,8) S:R="" R="UNKNOWN" S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Designated Mental Health Provider",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L(AMHRX),Y=38-Y W !?Y,AMHRX,?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. Q
  1. SS ;
  1. Q:'$D(AMHRTALL(9))
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,9) S:R="" R="UNKNOWN" S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Designated Social Services Provider",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L(AMHRX),Y=38-Y W !?Y,AMHRX,?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. Q
  1. CD ;
  1. Q:'$D(AMHRTALL(10))
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,10) S:R="" R="UNKNOWN" S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Designated A/SA Provider",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L(AMHRX),Y=38-Y W !?Y,AMHRX,?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. Q
  1. CLINIC ;
  1. Q:'$D(AMHRTALL(5))
  1. ;TALLY BY clinic
  1. K AMHRRES S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,6) S:R="" R="UNKNOWN" S AMHRRES(R)=$G(AMHRRES(R))+1
  1. W !
  1. W !," By Clinic",!
  1. S AMHRX="" F S AMHRX=$O(AMHRRES(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L(AMHRX),Y=38-Y W !?Y,AMHRX,?40,$J($$COM($G(AMHRRES(AMHRX)),0),8),?55,$$PER(AMHRRES(AMHRX),AMHRTOT) K AMHRRES(AMHRX)
  1. Q
  1. DATE ;
  1. Q:'$D(AMHRTALL(6))
  1. ;TALLY BY date OF service
  1. K ^TMP($J) S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X D
  1. .S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X) ;S D=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,""),-1) S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X,D)
  1. .S R=$P(AMHRY,U,1) S ^TMP($J,R)=$G(^TMP($J,R))+1
  1. W !
  1. W !," By Date",!
  1. S AMHRX="" F S AMHRX=$O(^TMP($J,AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. .Q:$$END
  1. .S Y=$L($$FMTE^XLFDT(AMHRX)),Y=38-Y W !?Y,$$FMTE^XLFDT(AMHRX),?40,$J($$COM($G(^TMP($J,AMHRX)),0),8),?55,$$PER(^TMP($J,AMHRX),AMHRTOT) K ^TMP($J,AMHRX)
  1. Q
  1. ;
  1. PER(N,D) ;return % of n/d
  1. I 'D Q "0%"
  1. NEW Z
  1. S Z=N/D,Z=Z*100,Z=$J(Z,5,1)
  1. Q $$STRIP^XLFSTR(Z," ")_"%"
  1. COM(X,X2,X3) ;
  1. D COMMA^%DTC
  1. Q $$STRIP^XLFSTR(X," ")
  1. END() ;
  1. I $Y<(IOSL-3) Q 0
  1. D HEADER
  1. I $D(AMHRQUIT) Q 1
  1. Q 0
  1. ENDL() ;
  1. I $Y<(IOSL-8) Q 0
  1. D HEADER
  1. I $D(AMHRQUIT) Q 1
  1. Q 0
  1. TOT() ;
  1. NEW C,X
  1. S C=0
  1. S X=0 F S X=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",X)) Q:X'=+X S C=C+1
  1. Q C
  1. G:'AMHRPG HEADER1
  1. K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHRQUIT="" Q
  1. HEADER1 ;
  1. W:$D(IOF) @IOF S AMHRPG=AMHRPG+1
  1. W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",AMHRPG,!
  1. W !,$$CTR("*** ALCOHOL SCREENING PATIENT TALLY"_$S(AMHRLIST:" AND PATIENT LISTING",1:"")_" ***",80),!
  1. S X="Screening Dates: "_$$FMTE^XLFDT(AMHRBD)_" to "_$$FMTE^XLFDT(AMHRED) W $$CTR(X,80),!
  1. I AMHREXPC S X="This report includes data from the PCC Clinical database" W $$CTR(X,80),!
  1. I 'AMHREXPC S X="This report excludes data from the PCC Clinical database" W $$CTR(X,80),!
  1. I $G(AMHRLSTP) W !?35,"DATE",!,"PATIENT NAME",?22,"HRN",?29,"AGE",?35,"SCREENED",?55,"CLINIC"
  1. W !,$TR($J("",80)," ","-")
  1. I '$G(AMHRLSTP) W !?46,"#",?53,"% of patients"
  1. Q
  1. DONE ;
  1. K ^TMP($J)
  1. K ^XTMP("AMHRAS1",AMHRJ,AMHRH)
  1. D EOP
  1. Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------
  1. EOP ;EP - End of page.
  1. Q:$E(IOST)'="C"
  1. Q:IO'=IO(0)
  1. Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1. NEW DIR
  1. K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1. W !
  1. S DIR("A")="End of Report. Press Enter",DIR(0)="E" D ^DIR
  1. Q
  1. ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1. Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1. ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1. Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1. ;----------
  1. LIST ;EP - called from xbdbque
  1. S AMHRPG=0 K AMHRQUIT
  1. S AMHRLSTP=1
  1. D HEADER
  1. K ^TMP($J)
  1. ;resort by sort item
  1. S DFN=0 F S DFN=$O(^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",DFN)) Q:DFN'=+DFN S AMHRY=^XTMP("AMHRAS1",AMHRJ,AMHRH,"PTS",DFN) D
  1. .D @AMHRSORT
  1. .I AMHRSORV="" S AMHRSORV="--"
  1. .S ^TMP($J,"PTS",AMHRSORV,DFN)=AMHRY
  1. .Q
  1. S AMHRSORV="" F S AMHRSORV=$O(^TMP($J,"PTS",AMHRSORV)) Q:AMHRSORV=""!($D(AMHRQUIT)) D
  1. .S DFN=0 F S DFN=$O(^TMP($J,"PTS",AMHRSORV,DFN)) Q:DFN'=+DFN!($D(AMHRQUIT)) D
  1. ..Q:$$ENDL
  1. ..S AMHRY=^TMP($J,"PTS",AMHRSORV,DFN)
  1. ..W !!,$E($P(^DPT(DFN,0),U),1,20),?22,$$HRN^AUPNPAT(DFN,DUZ(2)),?29,$P(AMHRY,U,4),?33,$P(^DPT(DFN,0),U,2),?35,$$DT($P(AMHRY,U,1)),?55,$E($P(AMHRY,U,6),1,20)
  1. ..W !?3,"Type/Result: ",$P($P(AMHRY,U,2),";")_" "_$P($P(AMHRY,U,2),";",2)
  1. ..I $P(AMHRY,U,12)]"" W !?3,"Comment: ",$P(AMHRY,U,12)
  1. ..I $P(AMHRY,U,20)="PCC" S AMHRV=$P(AMHRY,U,14) I AMHRV,$D(^AUPNVPOV("AD",AMHRV)) D
  1. ...S AMHRC=0 W !?3,"DXs: "
  1. ...S AMHRX=0 F S AMHRX=$O(^AUPNVPOV("AD",AMHRV,AMHRX)) Q:AMHRX'=+AMHRX!($D(AMHRQUIT)) D
  1. ....S AMHRC=AMHRC+1
  1. ....W:AMHRC'=1 ! W ?8,$$VAL^XBDIQ1(9000010.07,AMHRX,.01),?17,$E($$VAL^XBDIQ1(9000010.07,AMHRX,.04),1,60)
  1. ..I $P(AMHRY,U,20)="BH" S AMHRV=$P(AMHRY,U,13) I AMHRV,$D(^AMHRPRO("AD",AMHRV)) D
  1. ...S AMHRC=0 W !?3,"DXs: "
  1. ...S AMHRX=0 F S AMHRX=$O(^AMHRPRO("AD",AMHRV,AMHRX)) Q:AMHRX'=+AMHRX!($D(AMHRQUIT)) D
  1. ....S AMHRC=AMHRC+1
  1. ....W:AMHRC'=1 ! W ?8,$$VAL^XBDIQ1(9002011.01,AMHRX,.01),?17,$E($$VAL^XBDIQ1(9002011.01,AMHRX,.04),1,60)
  1. ..W !?3,"Primary Provider on Visit: ",?31,$P(AMHRY,U,7)
  1. ..W !?3," Provider who screened: ",?31,$P(AMHRY,U,5)
  1. ..I 'AMHRDP W ! Q
  1. ..K AMHRX S X=$$VAL^XBDIQ1(9002011.55,DFN,.02) I X]"" S AMHRX("MENTAL HEALTH")=X
  1. ..S X=$$VAL^XBDIQ1(9002011.55,DFN,.03) I X]"" S AMHRX("SOCIAL SERVICES")=X
  1. ..S X=$$VAL^XBDIQ1(9002011.55,DFN,.04) I X]"" S AMHRX("CHEMICAL DEPENDENCY")=X
  1. ..S X=$$VAL^XBDIQ1(9000001,DFN,.14) I X]"" S AMHRX("DESIGNATED PRIMARY PROVIDER")=X
  1. ..S AMHRXX=0 F S AMHRXX=$O(^BDPRECN("C",DFN,AMHRXX)) Q:AMHRXX'=+AMHRXX D
  1. ...S A=$$VAL^XBDIQ1(90360.1,AMHRXX,.01) I '$D(AMHRX(A)) S AMHRX(A)=$$VAL^XBDIQ1(90360.1,AMHRXX,.03)
  1. ..Q:'$D(AMHRX)
  1. ..W !?3," Designated Providers: "
  1. ..S AMHRX="",AMHRC=0 F S AMHRX=$O(AMHRX(AMHRX)) Q:AMHRX=""!($D(AMHRQUIT)) D
  1. ...Q:$$END
  1. ...S AMHRC=AMHRC+1
  1. ...W:AMHRC'=1 ! W ?31,$S(AMHRX="DESIGNATED PRIMARY PROVIDER":"PRIMARY CARE",1:AMHRX),": ",AMHRX(AMHRX)
  1. Q
  1. H ;
  1. S AMHRSORV=$$HRN^AUPNPAT(DFN,DUZ(2))
  1. Q
  1. N ;
  1. S AMHRSORV=$P(^DPT(DFN,0),U)
  1. Q
  1. P ;
  1. S AMHRSORV=$P(AMHRY,U,5)
  1. Q
  1. R ;
  1. S AMHRSORV=$P($P(AMHRY,U,2),";")_" "_$P($P(AMHRY,U,2),";",2)
  1. Q
  1. D ;
  1. S AMHRSORV=$P(AMHRY,U,1)
  1. Q
  1. A S AMHRSORV=$P(AMHRY,U,4)
  1. Q
  1. G ;
  1. S AMHRSORV=$P(AMHRY,U,3)
  1. Q
  1. C ;
  1. S AMHRSORV=$P(AMHRY,U,6)
  1. Q
  1. T ;
  1. S %=$$HRN^AUPNPAT(DFN,DUZ(2))
  1. S %=%+10000000,%=$E(%,7,8)_"-"_+$E(%,2,8)
  1. S AMHRSORV=%
  1. Q
  1. DT(D) ;EP
  1. I D="" Q ""
  1. Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
  1. ;