APCPREG.m

APCPREG ; IHS/TUCSON/LAB - OHPRD-TUCSON/LAB - Check Registration export AUGUST 14, 1992 ; [ 04/03/98  08:39 AM ]

 ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;;APR 03, 1998

CHKREG ; Code to check and see if a Registration tape has been

 ; created for all dates in this PCC tape range

 S (APCP("REG END"),APCP("REG"))="",APCP("RDFN")=0

 I '$D(^AGTXST(DUZ(2))) W:$D(ZTQUEUED) !!,$C(7),$C(7),"Patient Registration Transmission for this Facility has not been activated.",!,"No PCC Transmission can be done!  NOTIFY YOUR SUPERVISOR",! S APCP("QFLG")=19 Q

 F  S APCP("RDFN")=$O(^AGTXST(DUZ(2),1,APCP("RDFN"))) Q:APCP("RDFN")'=+APCP("RDFN")!(APCP("REG")=1)  S APCP("REG END")=$P(^AGTXST(DUZ(2),1,APCP("RDFN"),0),U) D CHKDATE

 I APCP("REG")="" S APCP("QFLG")=20 D REGINF

 K APCP("REG END"),APCP("REG"),APCP("RDFN")

 Q

CHKDATE ;

 I APCP("REG END")'<APCP("RUN END") S APCP("REG")=1

 Q

REGINF ;

 Q:$D(ZTQUEUED)

 W $C(7),$C(7),!!,"A Patient Registration Tape that includes all of the dates in the PCC",!,"date range has not been created!",!,"You cannot create a PCC tape until a Patient Registration tape has been created."

 W !,"SEE YOUR SUPERVISOR FOR ASSISTANCE",!

 Q

APCPREG   ; IHS/TUCSON/LAB - OHPRD-TUCSON/LAB - Check Registration export AUGUST 14, 1992 ; [ 04/03/98  08:39 AM ]

 +1       ;;2.0;IHS PCC DATA EXTRACTION SYSTEM;;APR 03, 1998

CHKREG    ; Code to check and see if a Registration tape has been

 +1       ; created for all dates in this PCC tape range

 +2        SET (APCP("REG END"),APCP("REG"))=""

           SET APCP("RDFN")=0

 +3        IF '$DATA(^AGTXST(DUZ(2)))

               IF $DATA(ZTQUEUED)

                   WRITE !!,$CHAR(7),$CHAR(7),"Patient Registration Transmission for this Facility has not been activated.",!,"No PCC Transmission can be done!  NOTIFY YOUR SUPERVISOR",!

               SET APCP("QFLG")=19

               QUIT 

 +4        FOR 

               SET APCP("RDFN")=$ORDER(^AGTXST(DUZ(2),1,APCP("RDFN")))

               IF APCP("RDFN")'=+APCP("RDFN")!(APCP("REG")=1)

                   QUIT 

               SET APCP("REG END")=$PIECE(^AGTXST(DUZ(2),1,APCP("RDFN"),0),U)

               DO CHKDATE

 +5        IF APCP("REG")=""

               SET APCP("QFLG")=20

               DO REGINF

 +6        KILL APCP("REG END"),APCP("REG"),APCP("RDFN")

 +7        QUIT 

CHKDATE   ;

 +1        IF APCP("REG END")'<APCP("RUN END")

               SET APCP("REG")=1

 +2        QUIT 

REGINF    ;

 +1        IF $DATA(ZTQUEUED)

               QUIT 

 +2        WRITE $CHAR(7),$CHAR(7),!!,"A Patient Registration Tape that includes all of the dates in the PCC",!,"date range has not been created!",!,"You cannot create a PCC tape until a Patient Registration tape has been created."

 +3        WRITE !,"SEE YOUR SUPERVISOR FOR ASSISTANCE",!

 +4        QUIT