APCPAPC.m

APCPAPC ; IHS/TUCSON/LAB - create APC,INPT and Contract transactions AUGUST 14, 1992 ; [ 04/15/02 8:52 AM ]

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

 ;

START ;process APC transactios

 ;

APC ;

 Q:"CV"[APCPV("TYPE")

 D CHKCL

 Q:$D(APCPV("SKIP"))

 D GETACC

 D ^APCPDRPP

 I $D(APCPE) D COUNT^APCPDR2 Q

 D ^APCPAA

 Q

 ;

 ;

CHKCL ;

 Q  ;don't do this

 Q:APCPV("CLINIC CODE")'=56

 I '$D(^AUPNVMED("AD",APCP("V DFN"))) S APCPV("SKIP")=1 Q

 S APCPV("CLINIC CODE")=39

 Q

 ;

GETACC ;EP - Get accept command if there is one and save variable

 ;$O THRU V POV'S FOR ACCEPT

 S APCPT(2)=0 F  S APCPT(2)=$O(^AUPNVPOV("AD",APCP("V DFN"),APCPT(2))) Q:APCPT(2)=""  I $P($G(^AUPNVPOV(APCPT(2),0)),U,14)]"" S APCPV("ACC")="ACC"

 Q:$D(APCPV("ACC"))

 ;$O THRU V PROCEDURES FOR ACCEPT

 S APCPT(2)=0 F  S APCPT(2)=$O(^AUPNVPRC("AD",APCP("V DFN"),APCPT(2))) Q:APCPT(2)=""  I $P(^AUPNVPRC(APCPT(2),0),U,9)]"" S APCPV("ACC")="ACC"

 Q:$D(APCPV("ACC"))

 S APCPT(1)=$O(^AUPNVINP("AD",APCP("V DFN"),""))

 Q:APCPT(1)=""

 S:$P(^AUPNVINP(APCPT(1),0),U,14)]"" APCPV("ACC")="ACC"

 Q

 ;

 ;

APCPAPC   ; IHS/TUCSON/LAB - create APC,INPT and Contract transactions AUGUST 14, 1992 ; [ 04/15/02 8:52 AM ]

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

 +2       ;

START     ;process APC transactios

 +1       ;

APC       ;

 +1        IF "CV"[APCPV("TYPE")

               QUIT 

 +2        DO CHKCL

 +3        IF $DATA(APCPV("SKIP"))

               QUIT 

 +4        DO GETACC

 +5        DO ^APCPDRPP

 +6        IF $DATA(APCPE)

               DO COUNT^APCPDR2

               QUIT 

 +7        DO ^APCPAA

 +8        QUIT 

 +9       ;

 +10      ;

CHKCL     ;

 +1       ;don't do this

           QUIT 

 +2        IF APCPV("CLINIC CODE")'=56

               QUIT 

 +3        IF '$DATA(^AUPNVMED("AD",APCP("V DFN")))

               SET APCPV("SKIP")=1

               QUIT 

 +4        SET APCPV("CLINIC CODE")=39

 +5        QUIT 

 +6       ;

GETACC    ;EP - Get accept command if there is one and save variable

 +1       ;$O THRU V POV'S FOR ACCEPT

 +2        SET APCPT(2)=0

           FOR 

               SET APCPT(2)=$ORDER(^AUPNVPOV("AD",APCP("V DFN"),APCPT(2)))

               IF APCPT(2)=""

                   QUIT 

               IF $PIECE($GET(^AUPNVPOV(APCPT(2),0)),U,14)]""

                   SET APCPV("ACC")="ACC"

 +3        IF $DATA(APCPV("ACC"))

               QUIT 

 +4       ;$O THRU V PROCEDURES FOR ACCEPT

 +5        SET APCPT(2)=0

           FOR 

               SET APCPT(2)=$ORDER(^AUPNVPRC("AD",APCP("V DFN"),APCPT(2)))

               IF APCPT(2)=""

                   QUIT 

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

                   SET APCPV("ACC")="ACC"

 +6        IF $DATA(APCPV("ACC"))

               QUIT 

 +7        SET APCPT(1)=$ORDER(^AUPNVINP("AD",APCP("V DFN"),""))

 +8        IF APCPT(1)=""

               QUIT 

 +9        IF $PIECE(^AUPNVINP(APCPT(1),0),U,14)]""

               SET APCPV("ACC")="ACC"

 +10       QUIT 

 +11      ;

 +12      ;