AGDATCK ; IHS/ASDS/EFG - CHECK DATA ;
;;7.1;PATIENT REGISTRATION;**11**;AUG 25,2005;Build 1
;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
;
;****************************************************************
;Please notify the Patient Care Component (PCC) maintenance
;programmer of any changes affecting validation of data.
;
;****************************************************************
;
D:'$D(AGOPT) ^AGVAR
S AG("DTOT")=0
K AG("ER")
Q:'$D(DFN)
I '$D(^DPT(DFN,0)) D
. S AG("DTOT")=AG("DTOT")+3
. F AGI=1,3,4 S AG("ER",AGI)=""
I '$D(^AUPNPAT(DFN,11)) D
. S AG("DTOT")=AG("DTOT")+4
. F AGI=5,6,8,9 S AG("ER",AGI)=""
I $D(^AUPNPAT(DFN,51))<10 D
. S AG("DTOT")=AG("DTOT")+1
. S AG("ER",7)=""
I '+$O(^AUPNPAT(DFN,41,0)) D
. S AG("DTOT")=AG("DTOT")+2
. S AG("ER",2)=""
. S AG("ER","NOHRN")=""
. S AG("ER",13)=""
NAME ;
G CHART:$D(AG("ER",1))
S X=$P(^DPT(DFN,0),U)
S (DA,D0)=DFN
X $P(^DD(2,.01,0),U,5,99)
K DA,D0
I '$D(X) D G END:AG("DTOT")=9
. S AG("DTOT")=AG("DTOT")+1
. S AG("ER",1)=""
CHART ;
G HRNPFAC ;eliminate fac:hrn check as Parent Fac:HRN is inclusive
HRNPFAC ;
G INACT:$D(AG("ER",13))
K AGRSITE
D ^AGTXRHRN
I $G(AGRHRN) D G INACT
. K AGRSITE,AGRHRN
S AG("ER",13)=""
S AG("DTOT")=AG("DTOT")+1
K AGRSITE,AGRHRN
INACT ;
G DOB
DOB ;
G SEX:$D(AG("ER",3))
I $P(^DPT(DFN,0),U,3)="" D
. S AG("ER",3)=""
. S AG("DTOT")=AG("DTOT")+1
SEX ;
G TRIBE:$D(AG("ER",4))
;IHS/OIT/NKD AG*7.1*11 MU2 - ALLOW FOR PATIENTS WITH UNKNOWN SEX
;I $P(^DPT(DFN,0),U,2)=""!("MF"'[$P(^DPT(DFN,0),U,2)) D
I $$GET1^DIQ(2,DFN,.02)="" D
. S AG("ER",4)=""
. S AG("DTOT")=AG("DTOT")+1
TRIBE ;
G QUANT:$D(AG("ER",5))
I $P(^AUPNPAT(DFN,11),U,8)="" D
. S AG("ER",5)=""
. S AG("DTOT")=AG("DTOT")+1
OLDTRIBE ;
G QUANT:$D(AG("ER",5))
I $P(^AUTTTRI($P(^AUPNPAT(DFN,11),U,8),0),U,4)="Y" D
. S AG("ER",12)=""
. S AG("DTOT")=AG("DTOT")+1
UNSTRIBE ;
G QUANT:$D(AG("ER",5))
I $P(^AUTTTRI($P(^AUPNPAT(DFN,11),U,8),0),U,2)=999 D
. S AG("ER",5)=""
. S AG("DTOT")=AG("DTOT")+1
QUANT ;
G COMM:$D(AG("ER",6))
I $P(^AUPNPAT(DFN,11),U,10)="" D
. S AG("ER",6)=""
. S AG("DTOT")=AG("DTOT")+1
COMM ;
G BEN:$D(AG("ER",7))
K AG("DATE")
S AG("I")=0
F AGI=1:1 S AG("I")=$O(^AUPNPAT(DFN,51,AG("I"))) G COMM1:AG("I")="" S AG("DATE")=AG("I")
COMM1 ;
G COMM2:'$D(AG("DATE"))
G COMM2:$P(^AUPNPAT(DFN,51,AG("DATE"),0),U,3)=""
G BEN
COMM2 ;
S AG("ER",7)=""
S AG("DTOT")=AG("DTOT")+1
BEN ;
G ELIG:$D(AG("ER",8))
I $P(^AUPNPAT(DFN,11),U,11)="" D G ELIG
. S AG("ER",8)=""
. S AG("DTOT")=AG("DTOT")+1
I '$D(^AUTTBEN($P(^AUPNPAT(DFN,11),U,11),0)) D
. S AG("ER",8)=""
. S AG("DTOT")=AG("DTOT")+1
ELIG ;
I AGOPT(14)'="Y" G END:$D(AG("ER",9)) D
. D ^AGELCHK
. S:$D(AG("ER",9)) AG("DTOT")=AG("DTOT")+1
END ;
K AG("I"),AGI,I,X
Q
AGDATCK ; IHS/ASDS/EFG - CHECK DATA ;
+1 ;;7.1;PATIENT REGISTRATION;**11**;AUG 25,2005;Build 1
+2 ;IHS/OIT/NKD AG*7.1*11 MU2 UNKNOWN SEX
+3 ;
+4 ;****************************************************************
+5 ;Please notify the Patient Care Component (PCC) maintenance
+6 ;programmer of any changes affecting validation of data.
+7 ;
+8 ;****************************************************************
+9 ;
+10 IF '$DATA(AGOPT)
DO ^AGVAR
+11 SET AG("DTOT")=0
+12 KILL AG("ER")
+13 IF '$DATA(DFN)
QUIT
+14 IF '$DATA(^DPT(DFN,0))
Begin DoDot:1
+15 SET AG("DTOT")=AG("DTOT")+3
+16 FOR AGI=1,3,4
SET AG("ER",AGI)=""
End DoDot:1
+17 IF '$DATA(^AUPNPAT(DFN,11))
Begin DoDot:1
+18 SET AG("DTOT")=AG("DTOT")+4
+19 FOR AGI=5,6,8,9
SET AG("ER",AGI)=""
End DoDot:1
+20 IF $DATA(^AUPNPAT(DFN,51))<10
Begin DoDot:1
+21 SET AG("DTOT")=AG("DTOT")+1
+22 SET AG("ER",7)=""
End DoDot:1
+23 IF '+$ORDER(^AUPNPAT(DFN,41,0))
Begin DoDot:1
+24 SET AG("DTOT")=AG("DTOT")+2
+25 SET AG("ER",2)=""
+26 SET AG("ER","NOHRN")=""
+27 SET AG("ER",13)=""
End DoDot:1
NAME ;
+1 IF $DATA(AG("ER",1))
GOTO CHART
+2 SET X=$PIECE(^DPT(DFN,0),U)
+3 SET (DA,D0)=DFN
+4 XECUTE $PIECE(^DD(2,.01,0),U,5,99)
+5 KILL DA,D0
+6 IF '$DATA(X)
Begin DoDot:1
+7 SET AG("DTOT")=AG("DTOT")+1
+8 SET AG("ER",1)=""
End DoDot:1
IF AG("DTOT")=9
GOTO END
CHART ;
+1 ;eliminate fac:hrn check as Parent Fac:HRN is inclusive
GOTO HRNPFAC
HRNPFAC ;
+1 IF $DATA(AG("ER",13))
GOTO INACT
+2 KILL AGRSITE
+3 DO ^AGTXRHRN
+4 IF $GET(AGRHRN)
Begin DoDot:1
+5 KILL AGRSITE,AGRHRN
End DoDot:1
GOTO INACT
+6 SET AG("ER",13)=""
+7 SET AG("DTOT")=AG("DTOT")+1
+8 KILL AGRSITE,AGRHRN
INACT ;
+1 GOTO DOB
DOB ;
+1 IF $DATA(AG("ER",3))
GOTO SEX
+2 IF $PIECE(^DPT(DFN,0),U,3)=""
Begin DoDot:1
+3 SET AG("ER",3)=""
+4 SET AG("DTOT")=AG("DTOT")+1
End DoDot:1
SEX ;
+1 IF $DATA(AG("ER",4))
GOTO TRIBE
+2 ;IHS/OIT/NKD AG*7.1*11 MU2 - ALLOW FOR PATIENTS WITH UNKNOWN SEX
+3 ;I $P(^DPT(DFN,0),U,2)=""!("MF"'[$P(^DPT(DFN,0),U,2)) D
+4 IF $$GET1^DIQ(2,DFN,.02)=""
Begin DoDot:1
+5 SET AG("ER",4)=""
+6 SET AG("DTOT")=AG("DTOT")+1
End DoDot:1
TRIBE ;
+1 IF $DATA(AG("ER",5))
GOTO QUANT
+2 IF $PIECE(^AUPNPAT(DFN,11),U,8)=""
Begin DoDot:1
+3 SET AG("ER",5)=""
+4 SET AG("DTOT")=AG("DTOT")+1
End DoDot:1
OLDTRIBE ;
+1 IF $DATA(AG("ER",5))
GOTO QUANT
+2 IF $PIECE(^AUTTTRI($PIECE(^AUPNPAT(DFN,11),U,8),0),U,4)="Y"
Begin DoDot:1
+3 SET AG("ER",12)=""
+4 SET AG("DTOT")=AG("DTOT")+1
End DoDot:1
UNSTRIBE ;
+1 IF $DATA(AG("ER",5))
GOTO QUANT
+2 IF $PIECE(^AUTTTRI($PIECE(^AUPNPAT(DFN,11),U,8),0),U,2)=999
Begin DoDot:1
+3 SET AG("ER",5)=""
+4 SET AG("DTOT")=AG("DTOT")+1
End DoDot:1
QUANT ;
+1 IF $DATA(AG("ER",6))
GOTO COMM
+2 IF $PIECE(^AUPNPAT(DFN,11),U,10)=""
Begin DoDot:1
+3 SET AG("ER",6)=""
+4 SET AG("DTOT")=AG("DTOT")+1
End DoDot:1
COMM ;
+1 IF $DATA(AG("ER",7))
GOTO BEN
+2 KILL AG("DATE")
+3 SET AG("I")=0
+4 FOR AGI=1:1
SET AG("I")=$ORDER(^AUPNPAT(DFN,51,AG("I")))
IF AG("I")=""
GOTO COMM1
SET AG("DATE")=AG("I")
COMM1 ;
+1 IF '$DATA(AG("DATE"))
GOTO COMM2
+2 IF $PIECE(^AUPNPAT(DFN,51,AG("DATE"),0),U,3)=""
GOTO COMM2
+3 GOTO BEN
COMM2 ;
+1 SET AG("ER",7)=""
+2 SET AG("DTOT")=AG("DTOT")+1
BEN ;
+1 IF $DATA(AG("ER",8))
GOTO ELIG
+2 IF $PIECE(^AUPNPAT(DFN,11),U,11)=""
Begin DoDot:1
+3 SET AG("ER",8)=""
+4 SET AG("DTOT")=AG("DTOT")+1
End DoDot:1
GOTO ELIG
+5 IF '$DATA(^AUTTBEN($PIECE(^AUPNPAT(DFN,11),U,11),0))
Begin DoDot:1
+6 SET AG("ER",8)=""
+7 SET AG("DTOT")=AG("DTOT")+1
End DoDot:1
ELIG ;
+1 IF AGOPT(14)'="Y"
IF $DATA(AG("ER",9))
GOTO END
Begin DoDot:1
+2 DO ^AGELCHK
+3 IF $DATA(AG("ER",9))
SET AG("DTOT")=AG("DTOT")+1
End DoDot:1
END ;
+1 KILL AG("I"),AGI,I,X
+2 QUIT
