APCHPWH1 ; IHS/CMI/LAB - Patient Wellness Handout ; 11 Oct 2011 5:44 PM
;;2.0;IHS PCC SUITE;**2,7,11**;MAY 14, 2009;Build 58
;
S(Y,F,C,T) ;EP - set up array
I '$G(F) S F=0
I '$G(T) S T=0
NEW %,X
;blank lines
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_X
D S1
Q
S1 ;
S %=$P($G(^TMP($J,"APCHPWH",0)),U)+1,$P(^TMP($J,"APCHPWH",0),U)=%
S ^TMP($J,"APCHPWH",%)=X
Q
;
EP(APCHSDFN,APCHPWHT,APCHPRTH) ;PEP - PASS DFN get back array of patient wellness handout
;handout returned in ^TMP("APCHPHS",$J,"APCHPWH"
;APCHPWHT - ien of the PWH type
;APCHPRTH - 1 if you don't want the header line printed
K ^TMP($J,"APCHPWH")
S ^TMP($J,"APCHPWH",0)=0
I '$G(APCHPWHT) S APCHPWHT=$O(^APCHPWHT("B","ADULT REGULAR",0))
I '$G(APCHPWHT) Q
D SETARRAY
Q
SETARRAY ;set up array containing pwh
;all handouts get this demographic section, the opening text is dependent on the age of the patient
NEW X,APCHPRV,APCHSO,APCHSCMP,APCHSCMI
I '$G(APCHPRTH) S X="My Wellness Handout",$E(X,40)="Report Date: "_$$FMTE^XLFDT(DT) D S(X)
S X="********** CONFIDENTIAL PATIENT INFORMATION ["_$P(^VA(200,DUZ,0),U,2)_"] "_$$FMTE^XLFDT(DT)_" **********" D S(X)
;S X=$P($P(^DPT(APCHSDFN,0),U),",",2)_" "_$P($P(^DPT(APCHSDFN,0),U),",")_" HRN: "_$$HRN^AUPNPAT(APCHSDFN,DUZ(2)),$E(X,50)=$S($P(^APCCCTRL(DUZ(2),0),U,13)]"":$P(^APCCCTRL(DUZ(2),0),U,13),1:$P(^DIC(4,DUZ(2),0),U)) D S(X,1)
S X=$P(^DPT(APCHSDFN,0),U)_" HRN: "_$$HRN^AUPNPAT(APCHSDFN,DUZ(2)),$E(X,50)=$S($P(^APCCCTRL(DUZ(2),0),U,13)]"":$P(^APCCCTRL(DUZ(2),0),U,13),1:$P(^DIC(4,DUZ(2),0),U)) D S(X,1)
S X=$$VAL^XBDIQ1(2,APCHSDFN,.111)
I $P($G(^APCCCTRL(DUZ(2),0)),U,18)]"" D I 1
.S $E(X,50)=$P(^APCCCTRL(DUZ(2),0),U,18)_$S($P(^APCCCTRL(DUZ(2),0),U,18)]"":", ",1:" ")_$S($P($G(^APCCCTRL(DUZ(2),0)),U,19):$P(^DIC(5,$P(^APCCCTRL(DUZ(2),0),U,19),0),U,2),1:"")_" "_$P(^APCCCTRL(DUZ(2),0),U,21) D S(X)
E S $E(X,50)=$$VAL^XBDIQ1(9999999.06,DUZ(2),.15)_$S($$VAL^XBDIQ1(9999999.06,DUZ(2),.15)]"":", ",1:" ")_$S($P($G(^AUTTLOC(DUZ(2),0)),U,16):$P(^DIC(5,$$VALI^XBDIQ1(9999999.06,DUZ(2),.16),0),U,2),1:"") D
.S X=X_" "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.17) D S(X)
S X=$$VAL^XBDIQ1(2,APCHSDFN,.114)_$S($$VAL^XBDIQ1(2,APCHSDFN,.114)]"":", ",1:" ")_$$VAL^XBDIQ1(2,APCHSDFN,.115)_" "_$$VAL^XBDIQ1(2,APCHSDFN,.116)
S APCHPRV=$$DPCP(APCHSDFN)
I APCHPRV D
.S $E(X,50)=$P(^VA(200,APCHPRV,0),U) D S(X)
I 'APCHPRV D S(X)
S X=$$VAL^XBDIQ1(2,APCHSDFN,.131),$E(X,50)=$P(^AUTTLOC(DUZ(2),0),U,11) D S(X) ;put provider phone at 50
;I $G(APCDVSIT)]"",$D(^AUPNVSIT("AC",APCHSDFN,APCDVSIT)) S APCHPROV=$$PRIMPROV^APCLV(APCDVSIT)
;S X="Hello "_$S($$SEX^AUPNPAT(APCHSDFN)="M":"Mr. ",1:"Ms. ")_$E($P($P(^DPT(APCHSDFN,0),U),","))_$$LOW^XLFSTR($E($P($P(^DPT(APCHSDFN,0),U),","),2,99))_"," D S(X,1)
I $$AGE^AUPNPAT(APCHSDFN)>12 D I 1
.S X="Thank you for choosing "_$S($P(^APCCCTRL(DUZ(2),0),U,13)]"":$P(^APCCCTRL(DUZ(2),0),U,13),1:$P(^DIC(4,DUZ(2),0),U))_"." D S(X,1)
.S X="This handout is a new way for you and your doctor to look at your health." D S(X)
E D
.S X="Thank you for visiting with us!" D S(X,1)
.S X="Please look at this information about your child's visit. If you have any" D S(X)
.S X="questions, contact your child's health care provider or ask at your next" D S(X)
.S X="clinic appointment." D S(X)
D EMERG
;now process each component assigned to this type
;
COMPS ;
;I $$AGE^AUPNPAT(APCHSDFN)<18 D S("This handout is designed for patients 18 years of age and older.",2) Q
S APCHSORD=0 F S APCHSORD=$O(^APCHPWHT(APCHPWHT,1,APCHSORD)) Q:APCHSORD'=+APCHSORD D
.S APCHSCMP=$P(^APCHPWHT(APCHPWHT,1,APCHSORD,0),U,2)
.Q:'APCHSCMP
.Q:'$D(^APCHPWHC(APCHSCMP,0))
.Q:$P(^APCHPWHC(APCHSCMP,0),U,2) ;INACTIVE
.S APCHSCMI=$P(^APCHPWHC(APCHSCMP,0),U,2)
.D @($P(APCHSCMI,";",1)_U_$P(APCHSCMI,";",2))
S X="******** END CONFIDENTIAL PATIENT INFORMATION ["_$P(^VA(200,DUZ,0),U,2)_"] "_$$FMTE^XLFDT(DT)_" ********" D S(X,2)
Q
;
DPCP(P) ;EP
NEW R
D ALLDP^BDPAPI(P,"DESIGNATED PRIMARY PROVIDER",.R)
I $D(R("DESIGNATED PRIMARY PROVIDER")) Q $P(R("DESIGNATED PRIMARY PROVIDER"),U,2)
S R=$P(^AUPNPAT(P,0),U,14) I R Q R
S R=""
Q R
;
HELP1 ;EP - called from help prompt of structure multiple
D EN^DDIOL("This field contains a number which specifies the relative order in which")
D EN^DDIOL("the related component will appear on the Patient Wellness Handout.")
D EN^DDIOL("The values for this field (i.e., for separte entries in the STRUCTURE")
D EN^DDIOL("multiple) need not be sequential, and need not be entered in sequence.")
D EN^DDIOL("For example, if entered in the order 5 10 7 15, the related components")
D EN^DDIOL("will appear in the order 5 7 10 15.")
Q
HELP2 ;EP - called from help prompt of measure multiple
D EN^DDIOL("This field contains a number which specifies the relative order in which")
D EN^DDIOL("the related MEASURE will appear within the QUALITY OF CARE TRANSPARENCY")
D EN^DDIOL("REPORT CARD component. The values for this field (i.e., for separate")
D EN^DDIOL("entries in the SEQUENCE multiple) need not be sequential, and need not")
D EN^DDIOL("be entered in sequence. For example, if entered in the order 5 10 7 15,")
D EN^DDIOL("the related components will appear in the order 5 7 10 15.")
Q
EMERG ;EP - emergency contact component
D SUBHEAD^APCHPWHU
S X="Emergency Contact: "_$$VAL^XBDIQ1(2,APCHSDFN,.331),$E(X,60)="My Blood Type: "_$$BLOODTYP(APCHSDFN) D S(X)
D S("Address: "_$$VAL^XBDIQ1(2,APCHSDFN,.333))
D S("City/State: "_$$VAL^XBDIQ1(2,APCHSDFN,.336)_$S($$VAL^XBDIQ1(2,APCHSDFN,.337)]"":", ",1:"")_$$VAL^XBDIQ1(2,APCHSDFN,.337)_" "_$$VAL^XBDIQ1(2,APCHSDFN,.338))
D S("Phone: "_$$VAL^XBDIQ1(2,APCHSDFN,.339))
D S(" ")
S Y=$$LASTER(APCHSDFN)
I Y D
.S X="Last ER visit: "_$$FMTE^XLFDT($$VD^APCLV(Y)) D S(X)
.S X=" Main reason for the visit: "_$$PRIMPOV^APCLV(Y,"E") D S(X)
S Y=$$LASTHOSP(APCHSDFN)
I Y D
.D S("Last Hospital Admission: "_$$FMTE^XLFDT($$VD^APCLV(Y)))
.D S(" Reason for admission: "_$$PRIMPOV^APCLV(Y,"E"))
Q
BLOODTYP(P) ;EP - get blood type for patient P
NEW B,L
S B=""
I $D(^DPT(P,"LR")) D
.S L=^DPT(P,"LR") ; get pt's LRDFN get Blood Bank blood type
.Q:L=""
.Q:'$D(^LR(L,0))
.S B=$P(^LR(L,0),U,5)
I B]"" Q B
Q $$VAL^XBDIQ1(9000001,P,.13)
LASTER(P) ;LAST VISIT TO CLINIC 30
;find last ER visit
NEW B,D,V,G
S G="",B=(9999999-DT)+1
F S B=$O(^AUPNVSIT("AA",P,B)) Q:B=""!(G) D
.S V=0 F S V=$O(^AUPNVSIT("AA",P,B,V)) Q:V'=+V!(G) D
..Q:'$D(^AUPNVSIT(V,0))
..Q:$P(^AUPNVSIT(V,0),U,11)
..Q:'$P(^AUPNVSIT(V,0),U,9)
..Q:$$CLINIC^APCLV(V,"C")'=30
..;Q:'$D(^AUPNVPOV("AD",V))
..;Q:'$D(^AUPNVPRV("AD",V))
..S G=V
Q G
LASTHOSP(P) ;LAST HOSP VISIT
;find last H visit
NEW B,D,V,G
S G="",B=(9999999-DT)+1
F S B=$O(^AUPNVSIT("AAH",P,B)) Q:B=""!(G) D
.S V=$O(^AUPNVSIT("AAH",P,B,0)) Q:V'=+V!(G) D
..Q:'$D(^AUPNVSIT(V,0))
..S G=V
Q G
APCHPWH1 ; IHS/CMI/LAB - Patient Wellness Handout ; 11 Oct 2011 5:44 PM
+1 ;;2.0;IHS PCC SUITE;**2,7,11**;MAY 14, 2009;Build 58
+2 ;
S(Y,F,C,T) ;EP - set up array
+1 IF '$GET(F)
SET F=0
+2 IF '$GET(T)
SET T=0
+3 NEW %,X
+4 ;blank lines
+5 FOR F=1:1:F
SET X=""
DO S1
+6 SET X=Y
+7 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+8 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+9 FOR %=1:1:T
SET X=" "_X
+10 DO S1
+11 QUIT
S1 ;
+1 SET %=$PIECE($GET(^TMP($JOB,"APCHPWH",0)),U)+1
SET $PIECE(^TMP($JOB,"APCHPWH",0),U)=%
+2 SET ^TMP($JOB,"APCHPWH",%)=X
+3 QUIT
+4 ;
EP(APCHSDFN,APCHPWHT,APCHPRTH) ;PEP - PASS DFN get back array of patient wellness handout
+1 ;handout returned in ^TMP("APCHPHS",$J,"APCHPWH"
+2 ;APCHPWHT - ien of the PWH type
+3 ;APCHPRTH - 1 if you don't want the header line printed
+4 KILL ^TMP($JOB,"APCHPWH")
+5 SET ^TMP($JOB,"APCHPWH",0)=0
+6 IF '$GET(APCHPWHT)
SET APCHPWHT=$ORDER(^APCHPWHT("B","ADULT REGULAR",0))
+7 IF '$GET(APCHPWHT)
QUIT
+8 DO SETARRAY
+9 QUIT
SETARRAY ;set up array containing pwh
+1 ;all handouts get this demographic section, the opening text is dependent on the age of the patient
+2 NEW X,APCHPRV,APCHSO,APCHSCMP,APCHSCMI
+3 IF '$GET(APCHPRTH)
SET X="My Wellness Handout"
SET $EXTRACT(X,40)="Report Date: "_$$FMTE^XLFDT(DT)
DO S(X)
+4 SET X="********** CONFIDENTIAL PATIENT INFORMATION ["_$PIECE(^VA(200,DUZ,0),U,2)_"] "_$$FMTE^XLFDT(DT)_" **********"
DO S(X)
+5 ;S X=$P($P(^DPT(APCHSDFN,0),U),",",2)_" "_$P($P(^DPT(APCHSDFN,0),U),",")_" HRN: "_$$HRN^AUPNPAT(APCHSDFN,DUZ(2)),$E(X,50)=$S($P(^APCCCTRL(DUZ(2),0),U,13)]"":$P(^APCCCTRL(DUZ(2),0),U,13),1:$P(^DIC(4,DUZ(2),0),U)) D S(X,1)
+6 SET X=$PIECE(^DPT(APCHSDFN,0),U)_" HRN: "_$$HRN^AUPNPAT(APCHSDFN,DUZ(2))
SET $EXTRACT(X,50)=$SELECT($PIECE(^APCCCTRL(DUZ(2),0),U,13)]"":$PIECE(^APCCCTRL(DUZ(2),0),U,13),1:$PIECE(^DIC(4,DUZ(2),0),U))
DO S(X,1)
+7 SET X=$$VAL^XBDIQ1(2,APCHSDFN,.111)
+8 IF $PIECE($GET(^APCCCTRL(DUZ(2),0)),U,18)]""
Begin DoDot:1
+9 SET $EXTRACT(X,50)=$PIECE(^APCCCTRL(DUZ(2),0),U,18)_$SELECT($PIECE(^APCCCTRL(DUZ(2),0),U,18)]"":", ",1:" ")_$SELECT($PIECE($GET(^APCCCTRL(DUZ(2),0)),U,19):$PIECE(^DIC(5,$PIECE(^APCCCTRL(DUZ(2),0),U,19),0),U,2),1:"")_" "_$PIECE(^APCCCTR
L(DUZ(2),0),U,21)
DO S(X)
End DoDot:1
IF 1
+10 IF '$TEST
SET $EXTRACT(X,50)=$$VAL^XBDIQ1(9999999.06,DUZ(2),.15)_$SELECT($$VAL^XBDIQ1(9999999.06,DUZ(2),.15)]"":", ",1:" ")_$SELECT($PIECE($GET(^AUTTLOC(DUZ(2),0)),U,16):$PIECE(^DIC(5,$$VALI^XBDIQ1(9999999.06,DUZ(2),.16),0),U,2),1:"")
Begin DoDot:1
+11 SET X=X_" "_$$VAL^XBDIQ1(9999999.06,DUZ(2),.17)
DO S(X)
End DoDot:1
+12 SET X=$$VAL^XBDIQ1(2,APCHSDFN,.114)_$SELECT($$VAL^XBDIQ1(2,APCHSDFN,.114)]"":", ",1:" ")_$$VAL^XBDIQ1(2,APCHSDFN,.115)_" "_$$VAL^XBDIQ1(2,APCHSDFN,.116)
+13 SET APCHPRV=$$DPCP(APCHSDFN)
+14 IF APCHPRV
Begin DoDot:1
+15 SET $EXTRACT(X,50)=$PIECE(^VA(200,APCHPRV,0),U)
DO S(X)
End DoDot:1
+16 IF 'APCHPRV
DO S(X)
+17 ;put provider phone at 50
SET X=$$VAL^XBDIQ1(2,APCHSDFN,.131)
SET $EXTRACT(X,50)=$PIECE(^AUTTLOC(DUZ(2),0),U,11)
DO S(X)
+18 ;I $G(APCDVSIT)]"",$D(^AUPNVSIT("AC",APCHSDFN,APCDVSIT)) S APCHPROV=$$PRIMPROV^APCLV(APCDVSIT)
+19 ;S X="Hello "_$S($$SEX^AUPNPAT(APCHSDFN)="M":"Mr. ",1:"Ms. ")_$E($P($P(^DPT(APCHSDFN,0),U),","))_$$LOW^XLFSTR($E($P($P(^DPT(APCHSDFN,0),U),","),2,99))_"," D S(X,1)
+20 IF $$AGE^AUPNPAT(APCHSDFN)>12
Begin DoDot:1
+21 SET X="Thank you for choosing "_$SELECT($PIECE(^APCCCTRL(DUZ(2),0),U,13)]"":$PIECE(^APCCCTRL(DUZ(2),0),U,13),1:$PIECE(^DIC(4,DUZ(2),0),U))_"."
DO S(X,1)
+22 SET X="This handout is a new way for you and your doctor to look at your health."
DO S(X)
End DoDot:1
IF 1
+23 IF '$TEST
Begin DoDot:1
+24 SET X="Thank you for visiting with us!"
DO S(X,1)
+25 SET X="Please look at this information about your child's visit. If you have any"
DO S(X)
+26 SET X="questions, contact your child's health care provider or ask at your next"
DO S(X)
+27 SET X="clinic appointment."
DO S(X)
End DoDot:1
+28 DO EMERG
+29 ;now process each component assigned to this type
+30 ;
COMPS ;
+1 ;I $$AGE^AUPNPAT(APCHSDFN)<18 D S("This handout is designed for patients 18 years of age and older.",2) Q
+2 SET APCHSORD=0
FOR
SET APCHSORD=$ORDER(^APCHPWHT(APCHPWHT,1,APCHSORD))
IF APCHSORD'=+APCHSORD
QUIT
Begin DoDot:1
+3 SET APCHSCMP=$PIECE(^APCHPWHT(APCHPWHT,1,APCHSORD,0),U,2)
+4 IF 'APCHSCMP
QUIT
+5 IF '$DATA(^APCHPWHC(APCHSCMP,0))
QUIT
+6 ;INACTIVE
IF $PIECE(^APCHPWHC(APCHSCMP,0),U,2)
QUIT
+7 SET APCHSCMI=$PIECE(^APCHPWHC(APCHSCMP,0),U,2)
+8 DO @($PIECE(APCHSCMI,";",1)_U_$PIECE(APCHSCMI,";",2))
End DoDot:1
+9 SET X="******** END CONFIDENTIAL PATIENT INFORMATION ["_$PIECE(^VA(200,DUZ,0),U,2)_"] "_$$FMTE^XLFDT(DT)_" ********"
DO S(X,2)
+10 QUIT
+11 ;
DPCP(P) ;EP
+1 NEW R
+2 DO ALLDP^BDPAPI(P,"DESIGNATED PRIMARY PROVIDER",.R)
+3 IF $DATA(R("DESIGNATED PRIMARY PROVIDER"))
QUIT $PIECE(R("DESIGNATED PRIMARY PROVIDER"),U,2)
+4 SET R=$PIECE(^AUPNPAT(P,0),U,14)
IF R
QUIT R
+5 SET R=""
+6 QUIT R
+7 ;
HELP1 ;EP - called from help prompt of structure multiple
+1 DO EN^DDIOL("This field contains a number which specifies the relative order in which")
+2 DO EN^DDIOL("the related component will appear on the Patient Wellness Handout.")
+3 DO EN^DDIOL("The values for this field (i.e., for separte entries in the STRUCTURE")
+4 DO EN^DDIOL("multiple) need not be sequential, and need not be entered in sequence.")
+5 DO EN^DDIOL("For example, if entered in the order 5 10 7 15, the related components")
+6 DO EN^DDIOL("will appear in the order 5 7 10 15.")
+7 QUIT
HELP2 ;EP - called from help prompt of measure multiple
+1 DO EN^DDIOL("This field contains a number which specifies the relative order in which")
+2 DO EN^DDIOL("the related MEASURE will appear within the QUALITY OF CARE TRANSPARENCY")
+3 DO EN^DDIOL("REPORT CARD component. The values for this field (i.e., for separate")
+4 DO EN^DDIOL("entries in the SEQUENCE multiple) need not be sequential, and need not")
+5 DO EN^DDIOL("be entered in sequence. For example, if entered in the order 5 10 7 15,")
+6 DO EN^DDIOL("the related components will appear in the order 5 7 10 15.")
+7 QUIT
EMERG ;EP - emergency contact component
+1 DO SUBHEAD^APCHPWHU
+2 SET X="Emergency Contact: "_$$VAL^XBDIQ1(2,APCHSDFN,.331)
SET $EXTRACT(X,60)="My Blood Type: "_$$BLOODTYP(APCHSDFN)
DO S(X)
+3 DO S("Address: "_$$VAL^XBDIQ1(2,APCHSDFN,.333))
+4 DO S("City/State: "_$$VAL^XBDIQ1(2,APCHSDFN,.336)_$SELECT($$VAL^XBDIQ1(2,APCHSDFN,.337)]"":", ",1:"")_$$VAL^XBDIQ1(2,APCHSDFN,.337)_" "_$$VAL^XBDIQ1(2,APCHSDFN,.338))
+5 DO S("Phone: "_$$VAL^XBDIQ1(2,APCHSDFN,.339))
+6 DO S(" ")
+7 SET Y=$$LASTER(APCHSDFN)
+8 IF Y
Begin DoDot:1
+9 SET X="Last ER visit: "_$$FMTE^XLFDT($$VD^APCLV(Y))
DO S(X)
+10 SET X=" Main reason for the visit: "_$$PRIMPOV^APCLV(Y,"E")
DO S(X)
End DoDot:1
+11 SET Y=$$LASTHOSP(APCHSDFN)
+12 IF Y
Begin DoDot:1
+13 DO S("Last Hospital Admission: "_$$FMTE^XLFDT($$VD^APCLV(Y)))
+14 DO S(" Reason for admission: "_$$PRIMPOV^APCLV(Y,"E"))
End DoDot:1
+15 QUIT
BLOODTYP(P) ;EP - get blood type for patient P
+1 NEW B,L
+2 SET B=""
+3 IF $DATA(^DPT(P,"LR"))
Begin DoDot:1
+4 ; get pt's LRDFN get Blood Bank blood type
SET L=^DPT(P,"LR")
+5 IF L=""
QUIT
+6 IF '$DATA(^LR(L,0))
QUIT
+7 SET B=$PIECE(^LR(L,0),U,5)
End DoDot:1
+8 IF B]""
QUIT B
+9 QUIT $$VAL^XBDIQ1(9000001,P,.13)
LASTER(P) ;LAST VISIT TO CLINIC 30
+1 ;find last ER visit
+2 NEW B,D,V,G
+3 SET G=""
SET B=(9999999-DT)+1
+4 FOR
SET B=$ORDER(^AUPNVSIT("AA",P,B))
IF B=""!(G)
QUIT
Begin DoDot:1
+5 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",P,B,V))
IF V'=+V!(G)
QUIT
Begin DoDot:2
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+7 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+8 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+9 IF $$CLINIC^APCLV(V,"C")'=30
QUIT
+10 ;Q:'$D(^AUPNVPOV("AD",V))
+11 ;Q:'$D(^AUPNVPRV("AD",V))
+12 SET G=V
End DoDot:2
End DoDot:1
+13 QUIT G
LASTHOSP(P) ;LAST HOSP VISIT
+1 ;find last H visit
+2 NEW B,D,V,G
+3 SET G=""
SET B=(9999999-DT)+1
+4 FOR
SET B=$ORDER(^AUPNVSIT("AAH",P,B))
IF B=""!(G)
QUIT
Begin DoDot:1
+5 SET V=$ORDER(^AUPNVSIT("AAH",P,B,0))
IF V'=+V!(G)
QUIT
Begin DoDot:2
+6 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+7 SET G=V
End DoDot:2
End DoDot:1
+8 QUIT G
