- 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
