VENPCC1A ; IHS/OIT/GIS - ENCOUNTER FORM DATA MINING ;
;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
; Patched for BCMA barcode string by GIS/OIT. Sting len
;
;
;
DEMO(PRV,DFN,VCN,VIEN,DEPTIEN,APPT) ; EP-GENERATE DEMOGRAPHIC INFO
NEW %,AGE,COMM,DOB,DOC,FMDOB,H,M,NAME,SEX,SSN,TRIBE,X,Z,ASUFAC,HRN,PAD
S X=$G(^DPT(+$G(DFN),0)) I X="" S STOP=1 Q
S SEX=$P(X,U,2),FMDOB=$P(X,U,3),SSN=$P(X,U,9),NAME=$P(X,U)
I $L(NAME),FMDOB,$L(SEX),$D(^VEN(7.95,DEPTIEN,0))
E S STOP=1 Q
S @TMP@(1,"b26")=$E(NAME,1,29)
I $G(APPT)?7N.E S Y=APPT X ^DD("DD") S @TMP@(1,"b25")=Y
S NAME=$P(NAME,",",2,99)_" "_$P(NAME,","),@TMP@(1,"patient")=$E(NAME,1,29) ; PATIENT
S ELIG=$$GET1^DIQ(9000001,DFN_",",1112) I ELIG="" S ELIG="ELIGIBILITY UNKNOWN"
S %=$P($G(^VEN(7.41,+$G(DEFEF),0)),U,3)
S @TMP@(1,"template")=%
; S %=$$PGRP^VENPCCU(DEPTIEN,0,$G(SPGRP)) I %="" S STOP=1 D ERR2^VENPCC1 Q
; S @TMP@(1,"group")=%
S @TMP@(1,"header")=$$HEADER^VENPCCU(DEFEF),@TMP@(1,"printer")=""
S @TMP@(1,"elig")=$E(ELIG,1,20)
S %=$$INS^VENPCC1C(DFN) I %="" S %="No record of 3rd party eligibility..."
S @TMP@(1,"b27")=$E(%,1,110) ; 3RD PARTY PAYORS
S @TMP@(1,"agesex")=$$AGE(FMDOB)_$S(SEX="F":"female",SEX="M":"male",1:"") ; AGESEX
S Y=FMDOB\1 X ^DD("DD") S @TMP@(1,"dob")=Y ; DOB
I SSN S @TMP@(1,"ssn")=$E(SSN,1,3)_" "_$E(SSN,4,5)_" "_$E(SSN,6,9) ; SSN
I VIEN'=+VIEN S @TMP@(1,"timestamp")="" G D1
; I '$D(^AUPNVSIT(+$G(VIEN),0)) S STOP=1 Q
S %DT="TX",X="NOW" D ^%DT S Z=$P(Y,".",2)
S Z=Z_$E("0000",1,(4-$L(Z))),H=$E(Z,1,2),M=$E(Z,3,4) ; TIMESTAMP
X ^DD("DD") S @TMP@(1,"timestamp")=$P(Y,"@")_"@"_H_":"_M
D1 S @TMP@(1,"uid")=$S(VCN'[".0X":VCN,1:"") ; VISIT CONTROL ID
I '$G(DEFEF) S DEFEF=$P($G(^VEN(7.95,+$G(DEPTIEN),2)),U,1)
S %=$P($G(^VEN(7.41,+$G(DEFEF),0)),U,4)
S @TMP@(1,"vbar1")="*"_VIEN_"."_%_"1*",@TMP@(1,"vbar2")="*"_VIEN_"."_%_"2*" ; BAR CODE
I $G(DEFEF) S @TMP@(1,"header")=$$HEADER^VENPCCU(DEFEF) ; GET SPECIAL HEADER FILE
S X=$P($G(^VA(200,PRV,0)),U),X=$P(X,",",2,99)_" "_$P(X,","),@TMP@(1,"provider")="Provider: "_$E(X,1,35) I X["GENERIC PROVIDER" S X="" ; PROVIDER
S @TMP@(1,"stop")="" ; CLINIC STOP
S @TMP@(1,"clinic")="" ; FACILITY
S TRIBE=+$P($G(^AUPNPAT(DFN,11)),U,8),@TMP@(1,"tribe")=$E($P($G(^AUTTTRI(TRIBE,0)),U),1,35) ; TRIBE
S %=$P($G(^AUPNPAT(DFN,11)),U,18) I $L(%) S @TMP@(1,"community")=$E(%,1,22)
E S %=$O(^AUPNPAT(DFN,51,99999999),-1) I % S COMM=$P($G(^AUPNPAT(DFN,51,%,0)),U,3) I COMM S @TMP@(1,"community")=$E($P($G(^AUTTCOM(COMM,0)),U),1,22) ; COMMUNITY
S @TMP@(1,"reqd")=$P($G(^VA(200,+$G(DUZ),0)),U) ; REQUESTED BY
S ASUFAC=$P($G(^AUTTLOC(DUZ(2),0)),U,10) I ASUFAC S @TMP@(1,"u61")=ASUFAC ; "u61" = ASUFAC CODE ; PATCHED BY GIS 10.13/08 FOR CIHA
S (HRN,@TMP@(1,"chart"))=$$CHART(DEPTIEN,DFN) I 'HRN Q ; CHART NUMBER
S PAD=$P($G(^VEN(7.5,$$CFG^VENPCCU,0)),U,25) I 'PAD S PAD=12
I ASUFAC,HRN,PAD S %=$L(HRN)+$L(ASUFAC),Z="",$P(Z,0,PAD+1-%)="",X=ASUFAC_Z_HRN S @TMP@(1,"u60")=X ; "u60" = ASUFAC_CHART # JUSTIFIED WITH ZEROS - TOTAL 18 CHARACTERS FOR VA BAR CODE READER ; PATCHED BY GIS 10.13/08 FOR CIHA
Q
;
AGE(DOB) ; EP-GIVEN DOB RETURNS FORMATTED AGE
NEW %,D,M,X,X1,X2,Y,%DT
S X=(DT-DOB)\10000 I X>3 Q (X_" y/o ")
S X1=DT,X2=DOB D ^%DTC
I X<22 Q (X_" d/o ")
I X<57 Q ((X\7)_" w/o ")
S Y=$E(DT,1,3)-$E(DOB,1,3),M=$E(DT,4,5)-$E(DOB,4,5),D=$E(DT,6,7)-$E(DOB,6,7)
S M=M+(12*Y) I D<0 S M=M-1
Q (M_" m/o ")
;
SPEC(DFN) ; EP-SPECIAL PATIENT INFO
NEW %,AGE,FMDOB,SEX,X
S X=^DPT(DFN,0),SEX=$P(X,U,2),FMDOB=$P(X,U,3)
S AGE=((DT-FMDOB)\10000) I AGE<6 D BH(DFN) Q
I SEX="F",AGE>10,AGE<60
E Q
FH ; EP-FEMALE HX
NEW RIEN,X,Y,Z
S @TMP@(1,"lab1")="LMP: "
S @TMP@(1,"lab2")="FP Method: "
S RIEN=$O(^AUPNREP("B",DFN,0)) I 'RIEN Q
S X=$G(^AUPNREP(RIEN,0)) I X="" Q
S Y=$P(X,U,2) I $L(Y) S @TMP@(1,"grav")="Repro Hx: "_Y ; CURES REPRO HX PARSING PROBLEMS
S Y=$P(X,U,7) I Y X ^DD("DD") S Y="("_Y_")" ; FPM START DATE
S Z=$P(X,U,6) I Z?1N S Z=Z+1,@TMP@(1,"fpm")=$P("Patient ed only^BC Pills^IUD^Surgical sterilization^Barrier method^Partner sterilized^Natural methods^Menopause^None",U,Z)_Y
Q
;
PARSE(Z) ; EP-PARSES OUT REPRODUCTIVE HISTORY FROM FREE TEXT NARRATIVE
NEW I
F I=1:1:$L(Z) Q:$E(Z,I)?1N
I $E(Z,I)?1N Q +$E(Z,I,99)
Q ""
;
GP(Y) ; EP-PARSES OUT REPRO HX
NEW %,G,L,P,S,T,X,Z
I Y["G" S X=$F(Y,"G"),Z=$E(Y,X,99),%=$$PARSE(Z) S @TMP@(1,"grav")="G "_% ; GRAVIDA
I Y["P" S X=$F(Y,"P"),Z=$E(Y,X,99),%=$$PARSE(Z) S @TMP@(1,"para")="P "_% ; PARA
I Y["L" S X=$F(Y,"L"),Z=$E(Y,X,99),%=$$PARSE(Z) S @TMP@(1,"lc")="LC "_% ; LC
I Y["S" S X=$F(Y,"S"),Z=$E(Y,X,99),%=$$PARSE(Z) S @TMP@(1,"ab")="SA "_% ; SAB
I Y["T" S X=$F(Y,"T"),Z=$E(Y,X,99),%=$$PARSE(Z) S @TMP@(1,"ab")=@TMP@(1,"ab")_" TA "_% ; TAB
Q
;
BH(DFN) ; EP-GIVEN DFN GETS BIRTH HX
NEW %,AS,BIEN,BW,DEL,GA,X
S BIEN=+$O(^AUPNBMSR("B",DFN,0))
S X=$G(^AUPNBMSR(BIEN,0))
S @TMP@(1,"lab1")="Location"
S @TMP@(1,"lab2")="Complications"
S %=$P(X,U,2) I %=+% D ; BIRTH WEIGHT
. I %>25 S @TMP@(1,"grav")=%_"gms" Q
. S @TMP@(1,"grav")=%_"lbs "_+$P(X,U,3)_"ozs"
. Q
E S @TMP@(1,"grav")="BW"
S %="",AS(1)=$P(X,U,4),AS(5)=$P(X,U,5)
I AS(1)=+AS(1) S %=AS(1) I AS(5)=+AS(5) S %=%_"/"_AS(5) ; APGAR 1/5
S @TMP@(1,"para")="AS "_%
S %=$P(X,U,6) S @TMP@(1,"lc")="GA "_% ; GESTATIONAL AGE
S %=$P(X,U,7) I $L(%) S @TMP@(1,"ab")=$E(%,1,10) ; DELIVERY TYPE
E S @TMP@(1,"ab")="Delivery"
S %=$P(X,U,8) I $L(%) S @TMP@(1,"fpm")=$E(%,1,20) ; COMPLICATIONS
Q
;
CHART(DEPTIEN,DFN) ; EP-GIVEN THE PATIENT DFN AND DEPT IEN RETURN THE CHART NMBR
NEW %,SIEN,X,Y
I $P($G(^VEN(7.5,+$G(CFIGIEN),0)),U,2) Q DFN ; FOR SITES THAT USE THE DFN AS THE RECORD NUMBER
S X=$G(^VEN(7.95,+$G(DEPTIEN),0))
I '$L(X) Q ""
S SIEN=$P($G(^VEN(7.95,+$G(DEPTIEN),2)),U,4) I 'SIEN S SIEN=$G(DUZ(2)) I 'SIEN Q ""
S Y=$P($G(^AUPNPAT(+$G(DFN),41,SIEN,0)),U,2)
Q Y
;
VENPCC1A ; IHS/OIT/GIS - ENCOUNTER FORM DATA MINING ;
+1 ;;2.6;PCC+;**1,3**;APR 03, 2012;Build 24
+2 ; Patched for BCMA barcode string by GIS/OIT. Sting len
+3 ;
+4 ;
+5 ;
DEMO(PRV,DFN,VCN,VIEN,DEPTIEN,APPT) ; EP-GENERATE DEMOGRAPHIC INFO
+1 NEW %,AGE,COMM,DOB,DOC,FMDOB,H,M,NAME,SEX,SSN,TRIBE,X,Z,ASUFAC,HRN,PAD
+2 SET X=$GET(^DPT(+$GET(DFN),0))
IF X=""
SET STOP=1
QUIT
+3 SET SEX=$PIECE(X,U,2)
SET FMDOB=$PIECE(X,U,3)
SET SSN=$PIECE(X,U,9)
SET NAME=$PIECE(X,U)
+4 IF $LENGTH(NAME)
IF FMDOB
IF $LENGTH(SEX)
IF $DATA(^VEN(7.95,DEPTIEN,0))
+5 IF '$TEST
SET STOP=1
QUIT
+6 SET @TMP@(1,"b26")=$EXTRACT(NAME,1,29)
+7 IF $GET(APPT)?7N.E
SET Y=APPT
XECUTE ^DD("DD")
SET @TMP@(1,"b25")=Y
+8 ; PATIENT
SET NAME=$PIECE(NAME,",",2,99)_" "_$PIECE(NAME,",")
SET @TMP@(1,"patient")=$EXTRACT(NAME,1,29)
+9 SET ELIG=$$GET1^DIQ(9000001,DFN_",",1112)
IF ELIG=""
SET ELIG="ELIGIBILITY UNKNOWN"
+10 SET %=$PIECE($GET(^VEN(7.41,+$GET(DEFEF),0)),U,3)
+11 SET @TMP@(1,"template")=%
+12 ; S %=$$PGRP^VENPCCU(DEPTIEN,0,$G(SPGRP)) I %="" S STOP=1 D ERR2^VENPCC1 Q
+13 ; S @TMP@(1,"group")=%
+14 SET @TMP@(1,"header")=$$HEADER^VENPCCU(DEFEF)
SET @TMP@(1,"printer")=""
+15 SET @TMP@(1,"elig")=$EXTRACT(ELIG,1,20)
+16 SET %=$$INS^VENPCC1C(DFN)
IF %=""
SET %="No record of 3rd party eligibility..."
+17 ; 3RD PARTY PAYORS
SET @TMP@(1,"b27")=$EXTRACT(%,1,110)
+18 ; AGESEX
SET @TMP@(1,"agesex")=$$AGE(FMDOB)_$SELECT(SEX="F":"female",SEX="M":"male",1:"")
+19 ; DOB
SET Y=FMDOB\1
XECUTE ^DD("DD")
SET @TMP@(1,"dob")=Y
+20 ; SSN
IF SSN
SET @TMP@(1,"ssn")=$EXTRACT(SSN,1,3)_" "_$EXTRACT(SSN,4,5)_" "_$EXTRACT(SSN,6,9)
+21 IF VIEN'=+VIEN
SET @TMP@(1,"timestamp")=""
GOTO D1
+22 ; I '$D(^AUPNVSIT(+$G(VIEN),0)) S STOP=1 Q
+23 SET %DT="TX"
SET X="NOW"
DO ^%DT
SET Z=$PIECE(Y,".",2)
+24 ; TIMESTAMP
SET Z=Z_$EXTRACT("0000",1,(4-$LENGTH(Z)))
SET H=$EXTRACT(Z,1,2)
SET M=$EXTRACT(Z,3,4)
+25 XECUTE ^DD("DD")
SET @TMP@(1,"timestamp")=$PIECE(Y,"@")_"@"_H_":"_M
D1 ; VISIT CONTROL ID
SET @TMP@(1,"uid")=$SELECT(VCN'[".0X":VCN,1:"")
+1 IF '$GET(DEFEF)
SET DEFEF=$PIECE($GET(^VEN(7.95,+$GET(DEPTIEN),2)),U,1)
+2 SET %=$PIECE($GET(^VEN(7.41,+$GET(DEFEF),0)),U,4)
+3 ; BAR CODE
SET @TMP@(1,"vbar1")="*"_VIEN_"."_%_"1*"
SET @TMP@(1,"vbar2")="*"_VIEN_"."_%_"2*"
+4 ; GET SPECIAL HEADER FILE
IF $GET(DEFEF)
SET @TMP@(1,"header")=$$HEADER^VENPCCU(DEFEF)
+5 ; PROVIDER
SET X=$PIECE($GET(^VA(200,PRV,0)),U)
SET X=$PIECE(X,",",2,99)_" "_$PIECE(X,",")
SET @TMP@(1,"provider")="Provider: "_$EXTRACT(X,1,35)
IF X["GENERIC PROVIDER"
SET X=""
+6 ; CLINIC STOP
SET @TMP@(1,"stop")=""
+7 ; FACILITY
SET @TMP@(1,"clinic")=""
+8 ; TRIBE
SET TRIBE=+$PIECE($GET(^AUPNPAT(DFN,11)),U,8)
SET @TMP@(1,"tribe")=$EXTRACT($PIECE($GET(^AUTTTRI(TRIBE,0)),U),1,35)
+9 SET %=$PIECE($GET(^AUPNPAT(DFN,11)),U,18)
IF $LENGTH(%)
SET @TMP@(1,"community")=$EXTRACT(%,1,22)
+10 ; COMMUNITY
IF '$TEST
SET %=$ORDER(^AUPNPAT(DFN,51,99999999),-1)
IF %
SET COMM=$PIECE($GET(^AUPNPAT(DFN,51,%,0)),U,3)
IF COMM
SET @TMP@(1,"community")=$EXTRACT($PIECE($GET(^AUTTCOM(COMM,0)),U),1,22)
+11 ; REQUESTED BY
SET @TMP@(1,"reqd")=$PIECE($GET(^VA(200,+$GET(DUZ),0)),U)
+12 ; "u61" = ASUFAC CODE ; PATCHED BY GIS 10.13/08 FOR CIHA
SET ASUFAC=$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,10)
IF ASUFAC
SET @TMP@(1,"u61")=ASUFAC
+13 ; CHART NUMBER
SET (HRN,@TMP@(1,"chart"))=$$CHART(DEPTIEN,DFN)
IF 'HRN
QUIT
+14 SET PAD=$PIECE($GET(^VEN(7.5,$$CFG^VENPCCU,0)),U,25)
IF 'PAD
SET PAD=12
+15 ; "u60" = ASUFAC_CHART # JUSTIFIED WITH ZEROS - TOTAL 18 CHARACTERS FOR VA BAR CODE READER ; PATCHED BY GIS 10.13/08 FOR CIHA
IF ASUFAC
IF HRN
IF PAD
SET %=$LENGTH(HRN)+$LENGTH(ASUFAC)
SET Z=""
SET $PIECE(Z,0,PAD+1-%)=""
SET X=ASUFAC_Z_HRN
SET @TMP@(1,"u60")=X
+16 QUIT
+17 ;
AGE(DOB) ; EP-GIVEN DOB RETURNS FORMATTED AGE
+1 NEW %,D,M,X,X1,X2,Y,%DT
+2 SET X=(DT-DOB)\10000
IF X>3
QUIT (X_" y/o ")
+3 SET X1=DT
SET X2=DOB
DO ^%DTC
+4 IF X<22
QUIT (X_" d/o ")
+5 IF X<57
QUIT ((X\7)_" w/o ")
+6 SET Y=$EXTRACT(DT,1,3)-$EXTRACT(DOB,1,3)
SET M=$EXTRACT(DT,4,5)-$EXTRACT(DOB,4,5)
SET D=$EXTRACT(DT,6,7)-$EXTRACT(DOB,6,7)
+7 SET M=M+(12*Y)
IF D<0
SET M=M-1
+8 QUIT (M_" m/o ")
+9 ;
SPEC(DFN) ; EP-SPECIAL PATIENT INFO
+1 NEW %,AGE,FMDOB,SEX,X
+2 SET X=^DPT(DFN,0)
SET SEX=$PIECE(X,U,2)
SET FMDOB=$PIECE(X,U,3)
+3 SET AGE=((DT-FMDOB)\10000)
IF AGE<6
DO BH(DFN)
QUIT
+4 IF SEX="F"
IF AGE>10
IF AGE<60
+5 IF '$TEST
QUIT
FH ; EP-FEMALE HX
+1 NEW RIEN,X,Y,Z
+2 SET @TMP@(1,"lab1")="LMP: "
+3 SET @TMP@(1,"lab2")="FP Method: "
+4 SET RIEN=$ORDER(^AUPNREP("B",DFN,0))
IF 'RIEN
QUIT
+5 SET X=$GET(^AUPNREP(RIEN,0))
IF X=""
QUIT
+6 ; CURES REPRO HX PARSING PROBLEMS
SET Y=$PIECE(X,U,2)
IF $LENGTH(Y)
SET @TMP@(1,"grav")="Repro Hx: "_Y
+7 ; FPM START DATE
SET Y=$PIECE(X,U,7)
IF Y
XECUTE ^DD("DD")
SET Y="("_Y_")"
+8 SET Z=$PIECE(X,U,6)
IF Z?1N
SET Z=Z+1
SET @TMP@(1,"fpm")=$PIECE("Patient ed only^BC Pills^IUD^Surgical sterilization^Barrier method^Partner sterilized^Natural methods^Menopause^None",U,Z)_Y
+9 QUIT
+10 ;
PARSE(Z) ; EP-PARSES OUT REPRODUCTIVE HISTORY FROM FREE TEXT NARRATIVE
+1 NEW I
+2 FOR I=1:1:$LENGTH(Z)
IF $EXTRACT(Z,I)?1N
QUIT
+3 IF $EXTRACT(Z,I)?1N
QUIT +$EXTRACT(Z,I,99)
+4 QUIT ""
+5 ;
GP(Y) ; EP-PARSES OUT REPRO HX
+1 NEW %,G,L,P,S,T,X,Z
+2 ; GRAVIDA
IF Y["G"
SET X=$FIND(Y,"G")
SET Z=$EXTRACT(Y,X,99)
SET %=$$PARSE(Z)
SET @TMP@(1,"grav")="G "_%
+3 ; PARA
IF Y["P"
SET X=$FIND(Y,"P")
SET Z=$EXTRACT(Y,X,99)
SET %=$$PARSE(Z)
SET @TMP@(1,"para")="P "_%
+4 ; LC
IF Y["L"
SET X=$FIND(Y,"L")
SET Z=$EXTRACT(Y,X,99)
SET %=$$PARSE(Z)
SET @TMP@(1,"lc")="LC "_%
+5 ; SAB
IF Y["S"
SET X=$FIND(Y,"S")
SET Z=$EXTRACT(Y,X,99)
SET %=$$PARSE(Z)
SET @TMP@(1,"ab")="SA "_%
+6 ; TAB
IF Y["T"
SET X=$FIND(Y,"T")
SET Z=$EXTRACT(Y,X,99)
SET %=$$PARSE(Z)
SET @TMP@(1,"ab")=@TMP@(1,"ab")_" TA "_%
+7 QUIT
+8 ;
BH(DFN) ; EP-GIVEN DFN GETS BIRTH HX
+1 NEW %,AS,BIEN,BW,DEL,GA,X
+2 SET BIEN=+$ORDER(^AUPNBMSR("B",DFN,0))
+3 SET X=$GET(^AUPNBMSR(BIEN,0))
+4 SET @TMP@(1,"lab1")="Location"
+5 SET @TMP@(1,"lab2")="Complications"
+6 ; BIRTH WEIGHT
SET %=$PIECE(X,U,2)
IF %=+%
Begin DoDot:1
+7 IF %>25
SET @TMP@(1,"grav")=%_"gms"
QUIT
+8 SET @TMP@(1,"grav")=%_"lbs "_+$PIECE(X,U,3)_"ozs"
+9 QUIT
End DoDot:1
+10 IF '$TEST
SET @TMP@(1,"grav")="BW"
+11 SET %=""
SET AS(1)=$PIECE(X,U,4)
SET AS(5)=$PIECE(X,U,5)
+12 ; APGAR 1/5
IF AS(1)=+AS(1)
SET %=AS(1)
IF AS(5)=+AS(5)
SET %=%_"/"_AS(5)
+13 SET @TMP@(1,"para")="AS "_%
+14 ; GESTATIONAL AGE
SET %=$PIECE(X,U,6)
SET @TMP@(1,"lc")="GA "_%
+15 ; DELIVERY TYPE
SET %=$PIECE(X,U,7)
IF $LENGTH(%)
SET @TMP@(1,"ab")=$EXTRACT(%,1,10)
+16 IF '$TEST
SET @TMP@(1,"ab")="Delivery"
+17 ; COMPLICATIONS
SET %=$PIECE(X,U,8)
IF $LENGTH(%)
SET @TMP@(1,"fpm")=$EXTRACT(%,1,20)
+18 QUIT
+19 ;
CHART(DEPTIEN,DFN) ; EP-GIVEN THE PATIENT DFN AND DEPT IEN RETURN THE CHART NMBR
+1 NEW %,SIEN,X,Y
+2 ; FOR SITES THAT USE THE DFN AS THE RECORD NUMBER
IF $PIECE($GET(^VEN(7.5,+$GET(CFIGIEN),0)),U,2)
QUIT DFN
+3 SET X=$GET(^VEN(7.95,+$GET(DEPTIEN),0))
+4 IF '$LENGTH(X)
QUIT ""
+5 SET SIEN=$PIECE($GET(^VEN(7.95,+$GET(DEPTIEN),2)),U,4)
IF 'SIEN
SET SIEN=$GET(DUZ(2))
IF 'SIEN
QUIT ""
+6 SET Y=$PIECE($GET(^AUPNPAT(+$GET(DFN),41,SIEN,0)),U,2)
+7 QUIT Y
+8 ;
