APCDRRQ ; IHS/CMI/LAB - CHECK REQUIRED DATA ITEMS OF PATIENT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
DOB ;
I AUPNDOB="" S APCDE="E600" D ERR Q
SEX ;
I AUPNSEX="" S APCDE="E601" D ERR Q
D HRN
I '$D(^AUPNPAT(AUPNPAT,11)) S APCDE="E602" D ERR Q
D TRIBE
D COMM
D QUANT
D BEN
D ELIG
EOJ ;
K APCDE,APCDHASF,APCDHRN,APCDPX,APCDX
Q
;
ERR ;
S APCDE("FILE")=9000001,APCDE("ENTRY")=AUPNPAT
D ERR^APCDRV
Q
HRN ;
S APCDHRN=""
D CHART
I APCDHRN="" S APCDE="E603" D ERR Q
I $E(APCDHRN)="T"!($L(APCDHRN)=7) S APCDE="E604" D ERR Q
Q
CHART ;
I $D(^AUPNPAT(AUPNPAT,41,APCDLDFN,0))#2,$P(^(0),U)]"",$P(^(0),U,2)]"" S APCDHRN=$P(^(0),U,2) Q
I $D(DUZ(2)),DUZ(2)>0,$D(^AUPNPAT(AUPNPAT,41,DUZ(2),0))#2,$P(^(0),U)]"",$P(^(0),U,2)]"" S APCDHRN=$P(^(0),U,2) Q
S APCDHASF=$O(^AUPNPAT(AUPNPAT,41,0))
I 'APCDHASF S APCDHRN="" Q
I APCDHASF S APCDHRN=$P(^AUPNPAT(AUPNPAT,41,APCDHASF,0),U,2)
Q
;
TRIBE ;
I $P(^AUPNPAT(AUPNPAT,11),U,8)="" S APCDE="E605" D ERR Q
I '$D(^AUTTTRI($P(^AUPNPAT(AUPNPAT,11),U,8))) S APCDE="E606" D ERR Q
OLDTRIBE I $P(^AUTTTRI($P(^AUPNPAT(AUPNPAT,11),U,8),0),U,4)="Y" S APCDE="E607" D ERR Q
Q
QUANT I $P(^AUPNPAT(AUPNPAT,11),U,10)="" S APCDE="E616" D ERR
Q
COMM ;
S APCDX=0,APCDPX="" F S APCDX=$O(^AUPNPAT(AUPNPAT,51,APCDX)) Q:APCDX'=+APCDX S APCDPX=APCDX
I APCDPX="" S APCDE="E610" D ERR Q
S APCDPX=$P(^AUPNPAT(AUPNPAT,51,APCDPX,0),U,3) I APCDPX="" S APCDE="E611" D ERR Q
I '$D(^AUTTCOM(APCDPX,0)) S APCDE="E611" D ERR Q
I APCDPX]"" S APCDX=$P(^AUTTCOM(APCDPX,0),U,8) I APCDX="" S APCDE="E612" D ERR Q
Q
BEN I $P(^AUPNPAT(AUPNPAT,11),U,11)="" S APCDE="E613" D ERR Q
I '$D(^AUTTBEN($P(^AUPNPAT(AUPNPAT,11),U,11),0)) S APCDE="E614" D ERR Q
Q
ELIG I $P(^AUPNPAT(AUPNPAT,11),U,12)="" S APCDE="E615" D ERR Q
Q
APCDRRQ ; IHS/CMI/LAB - CHECK REQUIRED DATA ITEMS OF PATIENT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
DOB ;
+1 IF AUPNDOB=""
SET APCDE="E600"
DO ERR
QUIT
SEX ;
+1 IF AUPNSEX=""
SET APCDE="E601"
DO ERR
QUIT
+2 DO HRN
+3 IF '$DATA(^AUPNPAT(AUPNPAT,11))
SET APCDE="E602"
DO ERR
QUIT
+4 DO TRIBE
+5 DO COMM
+6 DO QUANT
+7 DO BEN
+8 DO ELIG
EOJ ;
+1 KILL APCDE,APCDHASF,APCDHRN,APCDPX,APCDX
+2 QUIT
+3 ;
ERR ;
+1 SET APCDE("FILE")=9000001
SET APCDE("ENTRY")=AUPNPAT
+2 DO ERR^APCDRV
+3 QUIT
HRN ;
+1 SET APCDHRN=""
+2 DO CHART
+3 IF APCDHRN=""
SET APCDE="E603"
DO ERR
QUIT
+4 IF $EXTRACT(APCDHRN)="T"!($LENGTH(APCDHRN)=7)
SET APCDE="E604"
DO ERR
QUIT
+5 QUIT
CHART ;
+1 IF $DATA(^AUPNPAT(AUPNPAT,41,APCDLDFN,0))#2
IF $PIECE(^(0),U)]""
IF $PIECE(^(0),U,2)]""
SET APCDHRN=$PIECE(^(0),U,2)
QUIT
+2 IF $DATA(DUZ(2))
IF DUZ(2)>0
IF $DATA(^AUPNPAT(AUPNPAT,41,DUZ(2),0))#2
IF $PIECE(^(0),U)]""
IF $PIECE(^(0),U,2)]""
SET APCDHRN=$PIECE(^(0),U,2)
QUIT
+3 SET APCDHASF=$ORDER(^AUPNPAT(AUPNPAT,41,0))
+4 IF 'APCDHASF
SET APCDHRN=""
QUIT
+5 IF APCDHASF
SET APCDHRN=$PIECE(^AUPNPAT(AUPNPAT,41,APCDHASF,0),U,2)
+6 QUIT
+7 ;
TRIBE ;
+1 IF $PIECE(^AUPNPAT(AUPNPAT,11),U,8)=""
SET APCDE="E605"
DO ERR
QUIT
+2 IF '$DATA(^AUTTTRI($PIECE(^AUPNPAT(AUPNPAT,11),U,8)))
SET APCDE="E606"
DO ERR
QUIT
OLDTRIBE IF $PIECE(^AUTTTRI($PIECE(^AUPNPAT(AUPNPAT,11),U,8),0),U,4)="Y"
SET APCDE="E607"
DO ERR
QUIT
+1 QUIT
QUANT IF $PIECE(^AUPNPAT(AUPNPAT,11),U,10)=""
SET APCDE="E616"
DO ERR
+1 QUIT
COMM ;
+1 SET APCDX=0
SET APCDPX=""
FOR
SET APCDX=$ORDER(^AUPNPAT(AUPNPAT,51,APCDX))
IF APCDX'=+APCDX
QUIT
SET APCDPX=APCDX
+2 IF APCDPX=""
SET APCDE="E610"
DO ERR
QUIT
+3 SET APCDPX=$PIECE(^AUPNPAT(AUPNPAT,51,APCDPX,0),U,3)
IF APCDPX=""
SET APCDE="E611"
DO ERR
QUIT
+4 IF '$DATA(^AUTTCOM(APCDPX,0))
SET APCDE="E611"
DO ERR
QUIT
+5 IF APCDPX]""
SET APCDX=$PIECE(^AUTTCOM(APCDPX,0),U,8)
IF APCDX=""
SET APCDE="E612"
DO ERR
QUIT
+6 QUIT
BEN IF $PIECE(^AUPNPAT(AUPNPAT,11),U,11)=""
SET APCDE="E613"
DO ERR
QUIT
+1 IF '$DATA(^AUTTBEN($PIECE(^AUPNPAT(AUPNPAT,11),U,11),0))
SET APCDE="E614"
DO ERR
QUIT
+2 QUIT
ELIG IF $PIECE(^AUPNPAT(AUPNPAT,11),U,12)=""
SET APCDE="E615"
DO ERR
QUIT
+1 QUIT
