BQICMUT1 ;GDIT/HS/ALA-Care Mgmt Utility ; 11 Jun 2014 11:19 AM
;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
;
;
TAX(TMFRAME,TAX,PTDFN,FREF,SAME,TREF,START,END,RESULT) ;EP
; Return all values for a taxonomy (TAX) or list of taxonomies (TREF)
; Input
; TMFRAME - Timeframe to search for data
; TAX - Taxonomy (if singular taxonomy)
; PTDFN - Patient IEN
; FREF - File number reference
; SAME - If NIT is allowed for the same day or not (1 same day okay)
; TREF - Multiple same resulting taxonomies (e.g. MEDs) built
; into reference (usually global)
; START - Starting Date
; END - Ending Date
;
NEW GREF,ENDT,IEN,TIEN,TEMP,QFL,SRCTYP,VFL,VALUE
K RESULT
S TMFRAME=$G(TMFRAME,""),SAME=$G(SAME,1)
S TREF=$G(TREF,""),TAX=$G(TAX,"")
S START=$G(START,""),END=$G(END,"")
I $G(TMFRAME)'="" S ENDT=$$DATE^BQIUL1(TMFRAME),BDT=""
I $G(START)'=""!($G(END)'="") S ENDT=START,BDT=(9999999-END)-.001
I $G(UID)="" S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
I TAX'="" D
. S TREF=$NA(^TMP("BQITAX",UID))
. K @TREF
. D BLD^BQITUTL(TAX,TREF)
S GREF=$$ROOT^DILFD(FREF,"",1)
S TEMP=$NA(^TMP("BQITEMP",UID)) K @TEMP
;
S IEN="",QFL=0,CT=0
D
. I $G(TMFRAME)="",$G(START)="",$G(END)="" Q
. S VFL=$O(^BQI(90508.6,"B",FREF,""))
. I VFL'="" S SRCTYP=$P(^BQI(90508.6,VFL,0),U,3)
. S EDT=9999999-ENDT
. I SRCTYP'=2 D Q
.. F S BDT=$O(@GREF@("AA",PTDFN,BDT)) Q:BDT=""!(BDT>EDT) D
... S IEN=""
... F S IEN=$O(@GREF@("AA",PTDFN,BDT,IEN)) Q:IEN="" D
.... S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
.... I '$D(@TREF@(TIEN)) Q
.... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
.... I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.... S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
.... ;I $G(TMFRAME)'="",VSDTM<ENDT Q
.... S VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
.... ; Set temporary
.... S @TEMP@(VSDTM,VISIT,IEN)=VALUE
. S TIEN=""
. F S TIEN=$O(@TREF@(TIEN)) Q:TIEN="" D
.. I $G(TMFRAME)'="" S ENDT=$$DATE^BQIUL1(TMFRAME),BDT=""
.. I $G(START)'=""!($G(END)'="") S ENDT=START,BDT=(9999999-END)-.001
.. F S BDT=$O(@GREF@("AA",PTDFN,TIEN,BDT)) Q:BDT=""!(BDT>EDT) D
... S IEN=""
... F S IEN=$O(@GREF@("AA",PTDFN,TIEN,BDT,IEN)) Q:IEN="" D
.... S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
.... I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.... S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
.... S VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
.... S @TEMP@(VSDTM,VISIT,IEN)=VALUE
;
I $G(TMFRAME)="" D
. I $G(START)'="",$G(END)'="" Q
. F S IEN=$O(@GREF@("AC",PTDFN,IEN),-1) Q:IEN="" D
.. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
.. I '$D(@TREF@(TIEN)) Q
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") I VISIT="" Q
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
.. ;I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
.. ; Set temporary
.. S @TEMP@(VSDTM,VISIT,IEN)=VALUE
;
S VSDTM="",QFL=0
F S VSDTM=$O(@TEMP@(VSDTM),-1) Q:VSDTM=""!(QFL) D
. S VISIT=""
. F S VISIT=$O(@TEMP@(VSDTM,VISIT),-1) Q:VISIT="" D Q:QFL
.. S IEN=""
.. F S IEN=$O(@TEMP@(VSDTM,VISIT,IEN),-1) Q:IEN="" D Q:QFL
... ; If result cannot be on the same day, quit
... I 'SAME,$P(RESULT,U,2)=VSDTM Q
... S VALUE=@TEMP@(VSDTM,VISIT,IEN)
... S CT=CT+1
... S RESULT(CT)=VSDTM_U_VISIT_U_IEN_U_VALUE
S RESULT(0)=CT
K @TREF
Q
;
HF(DFN,TYP,TEXT) ;EP - Find Health Factor
; Input
; DFN - Patient IEN
; TYP - Category or Individual
; TEXT - Health Factor
;
NEW CAT,HFN,VALUE,RVDT
S CAT=$G(TYP,0),VALUE=""
S HFN=$O(^AUTTHF("B",TEXT,"")) I HFN="" Q VALUE
I 'CAT D Q VALUE
. S RVDT=$O(^AUPNVHF("AA",DFN,HFN,"")) I RVDT="" Q
. S IEN=$O(^AUPNVHF("AA",DFN,HFN,RVDT,""))
. S VALUE=$$FMTMDY^BQIUL1((9999999-RVDT))
;
I CAT D
. S HN="" F S HN=$O(^AUTTHF("AC",HFN,HN)) Q:HN="" D
.. S RVDT=$O(^AUPNVHF("AA",DFN,HN,"")) I RVDT="" Q
.. S IEN=$O(^AUPNVHF("AA",DFN,HN,RVDT,""))
.. S SORT(RVDT,HN,IEN)=""
. S RVDT=$O(SORT("")) I RVDT="" Q
. S HN=$O(SORT(RVDT,""))
. S VALUE=$$FMTMDY^BQIUL1((9999999-RVDT))_" ("_$P(^AUTTHF(HN,0),"^",1)_")"
Q VALUE
;
DEF(TYPE,RIEN,FIELD,RESULT) ;EP
NEW RES,MBY,MN,FILE,DN
I TYPE="MS" D
. S FILE=9000010.01,RESULT=""
. I FIELD=.04 D Q
.. S RES=$$GET1^DIQ(FILE,RIEN_",",FIELD,"E")
.. I RES?.N1".".N S RES=$J(RES,3,2)
.. S RESULT=1_U_RES
. I FIELD="DATE" D Q
.. S RES=$$VISD^BQICMUTL(FILE,RIEN)
.. I RES'="" S RESULT=1_U_(RES\1)
. I FIELD="BY" D Q
.. S MBY=$$GET1^DIQ(FILE,RIEN_",",".08","I")
.. I MBY="" S RESULT=0 Q
.. D USR(MBY)
. I FIELD="PBY" D Q
.. S MBY=$$GET1^DIQ(FILE,RIEN_",","1204","I")
.. I MBY="" S RESULT=0 Q
.. D USR(MBY)
. I FIELD="MBY" D Q
.. S MBY=$$GET1^DIQ(FILE,RIEN_",","1219","I")
.. I MBY="" S RESULT=0 Q
.. D USR(MBY)
. I FIELD=.01 D Q
.. S MN=$$GET1^DIQ(FILE,RIEN_",",FIELD,"I")
.. S RESULT=1_U_$P(^AUTTMSR(MN,0),U,2)_" ["_$P(^AUTTMSR(MN,0),U,1)_"]"
. I DIS="D" S RESULT=1_U_$$GET1^DIQ(FILE,RIEN_",",FIELD,"I") Q
. S RESULT=1_U_$$GET1^DIQ(FILE,RIEN_",",FIELD,"E")
. I RESULT="" S RESULT=0
;
I TYPE="DX" D
. S FILE=9000010.07,RESULT=""
. I FIELD="DATE" D Q
.. S RES=$$VISD^BQICMUTL(FILE,RIEN)
.. I RES'="" S RESULT=1_U_(RES\1)
. I FIELD=.01 D Q
.. S DN=$$GET1^DIQ(FILE,RIEN_",",FIELD,"I")
.. S RESULT=1_U_$$VST^ICDCODE(DN,"",80)_" ["_$$CODEC^ICDCODE(DN,80)_"]"
. I FIELD="PRIM" D Q
.. D POV(RIEN)
. I FIELD="PBY" D Q
.. S MBY=$$GET1^DIQ(FILE,RIEN_",","1204","I")
.. I MBY="" S RESULT=0 Q
.. D USR(MBY)
. I FIELD=.09!(FIELD=.21) D Q
.. S DN=$$GET1^DIQ(FILE,RIEN_",",FIELD,"I")
.. S RESULT=1_U_$$VST^ICDCODE(DN,"",80)_" ["_$$CODEC^ICDCODE(DN,80)_"]"
. I DIS="D" S RESULT=1_U_$$GET1^DIQ(FILE,RIEN_",",FIELD,"I") Q
. S RESULT=1_U_$$GET1^DIQ(FILE,RIEN_",",FIELD,"E")
. I RESULT="" S RESULT=0
Q
;
USR(MBY) ;EP
S RESULT=1_U_$P(^VA(200,MBY,0),"^",1)
Q
;
POV(PIEN) ;EP
NEW VISIT,IEEN,FLG,ORD,CT
I $G(^AUPNVPOV(PIEN,0))="" Q
S VISIT=$P(^AUPNVPOV(PIEN,0),"^",3)
S IEEN="",FLG=0,CT=0
F S IEEN=$O(^AUPNVPOV("AD",VISIT,IEEN)) Q:IEEN="" D
. I $P(^AUPNVPOV(IEEN,0),"^",12)'="" S FLG=1 Q
. S CT=CT+1,ORD(CT)=IEEN
I 'FLG D Q
. I ORD(1)=PIEN S RESULT=1_U_"PRIMARY" Q
. S RESULT=1_U_"SECONDARY"
S RESULT=1_U_$$GET1^DIQ(FILE,PIEN_",",.12,"E")
Q
BQICMUT1 ;GDIT/HS/ALA-Care Mgmt Utility ; 11 Jun 2014 11:19 AM
+1 ;;2.6;ICARE MANAGEMENT SYSTEM;;Jul 07, 2017;Build 72
+2 ;
+3 ;
TAX(TMFRAME,TAX,PTDFN,FREF,SAME,TREF,START,END,RESULT) ;EP
+1 ; Return all values for a taxonomy (TAX) or list of taxonomies (TREF)
+2 ; Input
+3 ; TMFRAME - Timeframe to search for data
+4 ; TAX - Taxonomy (if singular taxonomy)
+5 ; PTDFN - Patient IEN
+6 ; FREF - File number reference
+7 ; SAME - If NIT is allowed for the same day or not (1 same day okay)
+8 ; TREF - Multiple same resulting taxonomies (e.g. MEDs) built
+9 ; into reference (usually global)
+10 ; START - Starting Date
+11 ; END - Ending Date
+12 ;
+13 NEW GREF,ENDT,IEN,TIEN,TEMP,QFL,SRCTYP,VFL,VALUE
+14 KILL RESULT
+15 SET TMFRAME=$GET(TMFRAME,"")
SET SAME=$GET(SAME,1)
+16 SET TREF=$GET(TREF,"")
SET TAX=$GET(TAX,"")
+17 SET START=$GET(START,"")
SET END=$GET(END,"")
+18 IF $GET(TMFRAME)'=""
SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET BDT=""
+19 IF $GET(START)'=""!($GET(END)'="")
SET ENDT=START
SET BDT=(9999999-END)-.001
+20 IF $GET(UID)=""
SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+21 IF TAX'=""
Begin DoDot:1
+22 SET TREF=$NAME(^TMP("BQITAX",UID))
+23 KILL @TREF
+24 DO BLD^BQITUTL(TAX,TREF)
End DoDot:1
+25 SET GREF=$$ROOT^DILFD(FREF,"",1)
+26 SET TEMP=$NAME(^TMP("BQITEMP",UID))
KILL @TEMP
+27 ;
+28 SET IEN=""
SET QFL=0
SET CT=0
+29 Begin DoDot:1
+30 IF $GET(TMFRAME)=""
IF $GET(START)=""
IF $GET(END)=""
QUIT
+31 SET VFL=$ORDER(^BQI(90508.6,"B",FREF,""))
+32 IF VFL'=""
SET SRCTYP=$PIECE(^BQI(90508.6,VFL,0),U,3)
+33 SET EDT=9999999-ENDT
+34 IF SRCTYP'=2
Begin DoDot:2
+35 FOR
SET BDT=$ORDER(@GREF@("AA",PTDFN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:3
+36 SET IEN=""
+37 FOR
SET IEN=$ORDER(@GREF@("AA",PTDFN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+38 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+39 IF '$DATA(@TREF@(TIEN))
QUIT
+40 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+41 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+42 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+43 ;I $G(TMFRAME)'="",VSDTM<ENDT Q
+44 SET VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
+45 ; Set temporary
+46 SET @TEMP@(VSDTM,VISIT,IEN)=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+47 SET TIEN=""
+48 FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF TIEN=""
QUIT
Begin DoDot:2
+49 IF $GET(TMFRAME)'=""
SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET BDT=""
+50 IF $GET(START)'=""!($GET(END)'="")
SET ENDT=START
SET BDT=(9999999-END)-.001
+51 FOR
SET BDT=$ORDER(@GREF@("AA",PTDFN,TIEN,BDT))
IF BDT=""!(BDT>EDT)
QUIT
Begin DoDot:3
+52 SET IEN=""
+53 FOR
SET IEN=$ORDER(@GREF@("AA",PTDFN,TIEN,BDT,IEN))
IF IEN=""
QUIT
Begin DoDot:4
+54 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+55 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+56 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+57 SET VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
+58 SET @TEMP@(VSDTM,VISIT,IEN)=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+59 ;
+60 IF $GET(TMFRAME)=""
Begin DoDot:1
+61 IF $GET(START)'=""
IF $GET(END)'=""
QUIT
+62 FOR
SET IEN=$ORDER(@GREF@("AC",PTDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+63 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+64 IF '$DATA(@TREF@(TIEN))
QUIT
+65 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+66 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+67 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+68 ;I $G(TMFRAME)'="",VSDTM<ENDT Q
+69 SET VALUE=$$GET1^DIQ(FREF,IEN,.04,"E")
+70 ; Set temporary
+71 SET @TEMP@(VSDTM,VISIT,IEN)=VALUE
End DoDot:2
End DoDot:1
+72 ;
+73 SET VSDTM=""
SET QFL=0
+74 FOR
SET VSDTM=$ORDER(@TEMP@(VSDTM),-1)
IF VSDTM=""!(QFL)
QUIT
Begin DoDot:1
+75 SET VISIT=""
+76 FOR
SET VISIT=$ORDER(@TEMP@(VSDTM,VISIT),-1)
IF VISIT=""
QUIT
Begin DoDot:2
+77 SET IEN=""
+78 FOR
SET IEN=$ORDER(@TEMP@(VSDTM,VISIT,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+79 ; If result cannot be on the same day, quit
+80 IF 'SAME
IF $PIECE(RESULT,U,2)=VSDTM
QUIT
+81 SET VALUE=@TEMP@(VSDTM,VISIT,IEN)
+82 SET CT=CT+1
+83 SET RESULT(CT)=VSDTM_U_VISIT_U_IEN_U_VALUE
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+84 SET RESULT(0)=CT
+85 KILL @TREF
+86 QUIT
+87 ;
HF(DFN,TYP,TEXT) ;EP - Find Health Factor
+1 ; Input
+2 ; DFN - Patient IEN
+3 ; TYP - Category or Individual
+4 ; TEXT - Health Factor
+5 ;
+6 NEW CAT,HFN,VALUE,RVDT
+7 SET CAT=$GET(TYP,0)
SET VALUE=""
+8 SET HFN=$ORDER(^AUTTHF("B",TEXT,""))
IF HFN=""
QUIT VALUE
+9 IF 'CAT
Begin DoDot:1
+10 SET RVDT=$ORDER(^AUPNVHF("AA",DFN,HFN,""))
IF RVDT=""
QUIT
+11 SET IEN=$ORDER(^AUPNVHF("AA",DFN,HFN,RVDT,""))
+12 SET VALUE=$$FMTMDY^BQIUL1((9999999-RVDT))
End DoDot:1
QUIT VALUE
+13 ;
+14 IF CAT
Begin DoDot:1
+15 SET HN=""
FOR
SET HN=$ORDER(^AUTTHF("AC",HFN,HN))
IF HN=""
QUIT
Begin DoDot:2
+16 SET RVDT=$ORDER(^AUPNVHF("AA",DFN,HN,""))
IF RVDT=""
QUIT
+17 SET IEN=$ORDER(^AUPNVHF("AA",DFN,HN,RVDT,""))
+18 SET SORT(RVDT,HN,IEN)=""
End DoDot:2
+19 SET RVDT=$ORDER(SORT(""))
IF RVDT=""
QUIT
+20 SET HN=$ORDER(SORT(RVDT,""))
+21 SET VALUE=$$FMTMDY^BQIUL1((9999999-RVDT))_" ("_$PIECE(^AUTTHF(HN,0),"^",1)_")"
End DoDot:1
+22 QUIT VALUE
+23 ;
DEF(TYPE,RIEN,FIELD,RESULT) ;EP
+1 NEW RES,MBY,MN,FILE,DN
+2 IF TYPE="MS"
Begin DoDot:1
+3 SET FILE=9000010.01
SET RESULT=""
+4 IF FIELD=.04
Begin DoDot:2
+5 SET RES=$$GET1^DIQ(FILE,RIEN_",",FIELD,"E")
+6 IF RES?.N1".".N
SET RES=$JUSTIFY(RES,3,2)
+7 SET RESULT=1_U_RES
End DoDot:2
QUIT
+8 IF FIELD="DATE"
Begin DoDot:2
+9 SET RES=$$VISD^BQICMUTL(FILE,RIEN)
+10 IF RES'=""
SET RESULT=1_U_(RES\1)
End DoDot:2
QUIT
+11 IF FIELD="BY"
Begin DoDot:2
+12 SET MBY=$$GET1^DIQ(FILE,RIEN_",",".08","I")
+13 IF MBY=""
SET RESULT=0
QUIT
+14 DO USR(MBY)
End DoDot:2
QUIT
+15 IF FIELD="PBY"
Begin DoDot:2
+16 SET MBY=$$GET1^DIQ(FILE,RIEN_",","1204","I")
+17 IF MBY=""
SET RESULT=0
QUIT
+18 DO USR(MBY)
End DoDot:2
QUIT
+19 IF FIELD="MBY"
Begin DoDot:2
+20 SET MBY=$$GET1^DIQ(FILE,RIEN_",","1219","I")
+21 IF MBY=""
SET RESULT=0
QUIT
+22 DO USR(MBY)
End DoDot:2
QUIT
+23 IF FIELD=.01
Begin DoDot:2
+24 SET MN=$$GET1^DIQ(FILE,RIEN_",",FIELD,"I")
+25 SET RESULT=1_U_$PIECE(^AUTTMSR(MN,0),U,2)_" ["_$PIECE(^AUTTMSR(MN,0),U,1)_"]"
End DoDot:2
QUIT
+26 IF DIS="D"
SET RESULT=1_U_$$GET1^DIQ(FILE,RIEN_",",FIELD,"I")
QUIT
+27 SET RESULT=1_U_$$GET1^DIQ(FILE,RIEN_",",FIELD,"E")
+28 IF RESULT=""
SET RESULT=0
End DoDot:1
+29 ;
+30 IF TYPE="DX"
Begin DoDot:1
+31 SET FILE=9000010.07
SET RESULT=""
+32 IF FIELD="DATE"
Begin DoDot:2
+33 SET RES=$$VISD^BQICMUTL(FILE,RIEN)
+34 IF RES'=""
SET RESULT=1_U_(RES\1)
End DoDot:2
QUIT
+35 IF FIELD=.01
Begin DoDot:2
+36 SET DN=$$GET1^DIQ(FILE,RIEN_",",FIELD,"I")
+37 SET RESULT=1_U_$$VST^ICDCODE(DN,"",80)_" ["_$$CODEC^ICDCODE(DN,80)_"]"
End DoDot:2
QUIT
+38 IF FIELD="PRIM"
Begin DoDot:2
+39 DO POV(RIEN)
End DoDot:2
QUIT
+40 IF FIELD="PBY"
Begin DoDot:2
+41 SET MBY=$$GET1^DIQ(FILE,RIEN_",","1204","I")
+42 IF MBY=""
SET RESULT=0
QUIT
+43 DO USR(MBY)
End DoDot:2
QUIT
+44 IF FIELD=.09!(FIELD=.21)
Begin DoDot:2
+45 SET DN=$$GET1^DIQ(FILE,RIEN_",",FIELD,"I")
+46 SET RESULT=1_U_$$VST^ICDCODE(DN,"",80)_" ["_$$CODEC^ICDCODE(DN,80)_"]"
End DoDot:2
QUIT
+47 IF DIS="D"
SET RESULT=1_U_$$GET1^DIQ(FILE,RIEN_",",FIELD,"I")
QUIT
+48 SET RESULT=1_U_$$GET1^DIQ(FILE,RIEN_",",FIELD,"E")
+49 IF RESULT=""
SET RESULT=0
End DoDot:1
+50 QUIT
+51 ;
USR(MBY) ;EP
+1 SET RESULT=1_U_$PIECE(^VA(200,MBY,0),"^",1)
+2 QUIT
+3 ;
POV(PIEN) ;EP
+1 NEW VISIT,IEEN,FLG,ORD,CT
+2 IF $GET(^AUPNVPOV(PIEN,0))=""
QUIT
+3 SET VISIT=$PIECE(^AUPNVPOV(PIEN,0),"^",3)
+4 SET IEEN=""
SET FLG=0
SET CT=0
+5 FOR
SET IEEN=$ORDER(^AUPNVPOV("AD",VISIT,IEEN))
IF IEEN=""
QUIT
Begin DoDot:1
+6 IF $PIECE(^AUPNVPOV(IEEN,0),"^",12)'=""
SET FLG=1
QUIT
+7 SET CT=CT+1
SET ORD(CT)=IEEN
End DoDot:1
+8 IF 'FLG
Begin DoDot:1
+9 IF ORD(1)=PIEN
SET RESULT=1_U_"PRIMARY"
QUIT
+10 SET RESULT=1_U_"SECONDARY"
End DoDot:1
QUIT
+11 SET RESULT=1_U_$$GET1^DIQ(FILE,PIEN_",",.12,"E")
+12 QUIT
