- 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
