APCDEMDI.m

APCDEMDI ; IHS/CMI/LAB - CHECK FOR 8 MANDATORY DATA ITEMS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;CHECKS FOR EIGHT MANDATORY DATA ITEMS IN PAT. REG.

START ;

 K APCDMAND

 S APCDMAND("ERRCNT")=0

 D CHECK

 I APCDMAND("ERRCNT")>0 D PRINT

EXIT ;EXIT ROUTINE

 K APCDMAND

 Q

ADD ;

 S APCDMAND("ERRCNT")=APCDMAND("ERRCNT")+1

 Q

CHECK ;CHECK DATA ITEMS

DOB ;

 I AUPNDOB="" D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing DOB    ******"

SEX ;

 I AUPNSEX="" D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing/invalid SEX     ******"

 ;

HRN ;

 S APCDMAND("HRN")=""

 D CHART

 I APCDMAND("HRN")="" D ADD S APCDMAND("ERROR")="missing/invalid Chart Number    ******"

 I $E(APCDMAND("HRN"))="T"!($L(APCDMAND("HRN"))=7) D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="Temporary Chart Number Used    ******"

TRIBE ;

 I '$D(^AUPNPAT(AUPNPAT,11)) D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing TRIBE     ******" G COMM

 I $P(^AUPNPAT(AUPNPAT,11),U,8)="" D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing TRIBE    ******" G COMM

 I '$D(^AUTTTRI($P(^AUPNPAT(AUPNPAT,11),U,8))) D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing TRIBE    ******" G COMM

OLDTRIBE I $P(^AUTTTRI($P(^AUPNPAT(AUPNPAT,11),U,8),0),U,4)="Y" D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="OLD/UNUSED TRIBE Code Used    ******"

COMM ;

 S APCDMAND("X")=0,APCDMAND("PX")="" F  S APCDMAND("X")=$O(^AUPNPAT(AUPNPAT,51,APCDMAND("X"))) Q:APCDMAND("X")'=+APCDMAND("X")  S APCDMAND("PX")=APCDMAND("X")

 I APCDMAND("PX")="" D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing CURRENT COMMUNITY    ******" Q

 S APCDMAND("PX")=$P(^AUPNPAT(AUPNPAT,51,APCDMAND("PX"),0),U,3) I APCDMAND("PX")="" D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing CURRENT COMMUNITY    ******" Q

 I '$D(^AUTTCOM(APCDMAND("PX"),0)) D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing CURRENT COMMUNITY    ******" Q

 I APCDMAND("PX")]"" S APCDMAND("X")=$P(^AUTTCOM(APCDMAND("PX"),0),U,8) I APCDMAND("X")="" D ADD S APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing CURRENT COMMUNITY IHS CODE     ******"

 Q

CHART ;

 I $D(^AUPNPAT(AUPNPAT,41,AUPNPAT,0))#2,$P(^(0),U)]"",$P(^(0),U,2)]"" S APCDMAND("HRN")=$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 APCDMAND("HRN")=$P(^(0),U,2) Q

 S APCDMAND("HASF")=$O(^AUPNPAT(AUPNPAT,41,0))

 I 'APCDMAND("HASF") S APCDMAND("HRN")="" Q

 I APCDMAND("HASF") S APCDMAND("HRN")=$P(^AUPNPAT(AUPNPAT,41,APCDMAND("HASF"),0),U,2)

 Q

 ;

PRINT ;

 W:$D(^DPT(AUPNPAT,0)) !,"PATIENT: ",$P(^DPT(AUPNPAT,0),"^")

 W !,$C(7),$C(7),"This patient does not have a complete set of mandatory data.",!,"The missing or invalid data fields are...."

 S APCDMAND("X")=0 F  S APCDMAND("X")=$O(APCDMAND("ERROR",APCDMAND("X"))) Q:APCDMAND("X")=""  W !?10,".  ",APCDMAND("ERROR",APCDMAND("X"))

 W !!,"Copy down the information above in order to make the corrections.",!?5,"Press ANY KEY when ready. "

 R APCDMAND("X"):DTIME

 W "   Now continuing with Data Entry....."

 Q

APCDEMDI  ; IHS/CMI/LAB - CHECK FOR 8 MANDATORY DATA ITEMS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;CHECKS FOR EIGHT MANDATORY DATA ITEMS IN PAT. REG.

START     ;

 +1        KILL APCDMAND

 +2        SET APCDMAND("ERRCNT")=0

 +3        DO CHECK

 +4        IF APCDMAND("ERRCNT")>0

               DO PRINT

EXIT      ;EXIT ROUTINE

 +1        KILL APCDMAND

 +2        QUIT 

ADD       ;

 +1        SET APCDMAND("ERRCNT")=APCDMAND("ERRCNT")+1

 +2        QUIT 

CHECK     ;CHECK DATA ITEMS

DOB       ;

 +1        IF AUPNDOB=""

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing DOB    ******"

SEX       ;

 +1        IF AUPNSEX=""

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing/invalid SEX     ******"

 +2       ;

HRN       ;

 +1        SET APCDMAND("HRN")=""

 +2        DO CHART

 +3        IF APCDMAND("HRN")=""

               DO ADD

               SET APCDMAND("ERROR")="missing/invalid Chart Number    ******"

 +4        IF $EXTRACT(APCDMAND("HRN"))="T"!($LENGTH(APCDMAND("HRN"))=7)

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="Temporary Chart Number Used    ******"

TRIBE     ;

 +1        IF '$DATA(^AUPNPAT(AUPNPAT,11))

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing TRIBE     ******"

               GOTO COMM

 +2        IF $PIECE(^AUPNPAT(AUPNPAT,11),U,8)=""

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing TRIBE    ******"

               GOTO COMM

 +3        IF '$DATA(^AUTTTRI($PIECE(^AUPNPAT(AUPNPAT,11),U,8)))

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing TRIBE    ******"

               GOTO COMM

OLDTRIBE   IF $PIECE(^AUTTTRI($PIECE(^AUPNPAT(AUPNPAT,11),U,8),0),U,4)="Y"

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="OLD/UNUSED TRIBE Code Used    ******"

COMM      ;

 +1        SET APCDMAND("X")=0

           SET APCDMAND("PX")=""

           FOR 

               SET APCDMAND("X")=$ORDER(^AUPNPAT(AUPNPAT,51,APCDMAND("X")))

               IF APCDMAND("X")'=+APCDMAND("X")

                   QUIT 

               SET APCDMAND("PX")=APCDMAND("X")

 +2        IF APCDMAND("PX")=""

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing CURRENT COMMUNITY    ******"

               QUIT 

 +3        SET APCDMAND("PX")=$PIECE(^AUPNPAT(AUPNPAT,51,APCDMAND("PX"),0),U,3)

           IF APCDMAND("PX")=""

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing CURRENT COMMUNITY    ******"

               QUIT 

 +4        IF '$DATA(^AUTTCOM(APCDMAND("PX"),0))

               DO ADD

               SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing CURRENT COMMUNITY    ******"

               QUIT 

 +5        IF APCDMAND("PX")]""

               SET APCDMAND("X")=$PIECE(^AUTTCOM(APCDMAND("PX"),0),U,8)

               IF APCDMAND("X")=""

                   DO ADD

                   SET APCDMAND("ERROR",APCDMAND("ERRCNT"))="missing CURRENT COMMUNITY IHS CODE     ******"

 +6        QUIT 

CHART     ;

 +1        IF $DATA(^AUPNPAT(AUPNPAT,41,AUPNPAT,0))#2

               IF $PIECE(^(0),U)]""

                   IF $PIECE(^(0),U,2)]""

                       SET APCDMAND("HRN")=$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 APCDMAND("HRN")=$PIECE(^(0),U,2)

                               QUIT 

 +3        SET APCDMAND("HASF")=$ORDER(^AUPNPAT(AUPNPAT,41,0))

 +4        IF 'APCDMAND("HASF")

               SET APCDMAND("HRN")=""

               QUIT 

 +5        IF APCDMAND("HASF")

               SET APCDMAND("HRN")=$PIECE(^AUPNPAT(AUPNPAT,41,APCDMAND("HASF"),0),U,2)

 +6        QUIT 

 +7       ;

PRINT     ;

 +1        IF $DATA(^DPT(AUPNPAT,0))

               WRITE !,"PATIENT: ",$PIECE(^DPT(AUPNPAT,0),"^")

 +2        WRITE !,$CHAR(7),$CHAR(7),"This patient does not have a complete set of mandatory data.",!,"The missing or invalid data fields are...."

 +3        SET APCDMAND("X")=0

           FOR 

               SET APCDMAND("X")=$ORDER(APCDMAND("ERROR",APCDMAND("X")))

               IF APCDMAND("X")=""

                   QUIT 

               WRITE !?10,".  ",APCDMAND("ERROR",APCDMAND("X"))

 +4        WRITE !!,"Copy down the information above in order to make the corrections.",!?5,"Press ANY KEY when ready. "

 +5        READ APCDMAND("X"):DTIME

 +6        WRITE "   Now continuing with Data Entry....."

 +7        QUIT