APCLER11.m

APCLER11 ; IHS/CMI/LAB - APC REPORT PROCESS ;

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

 ;IHS/CMI/LAB - patch 5 fixed to only use 72 hours

 ;

START ;

 S APCLBT=$H

 K ^XTMP("APCLER1",APCLJOB,APCLBTH)

 D XTMP^APCLOSUT("APCLER1","PCC - ER RPT 1")

 ;

V ; Run by visit date

 S APCLODAT=APCLSD_".9999" F  S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED)  D V1

 ;

END ;

 S APCLET=$H

 D EOJ

 Q

V1 ;

 ;count only visits with a clinic = the value in APCLCLN

 S APCLVDFN="" F  S APCLVDFN=$O(^AUPNVSIT("B",APCLODAT,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN  I $D(^AUPNVSIT(APCLVDFN,0)),$P(^(0),U,9),'$P(^(0),U,11) S APCLVREC=^(0) D PROC

 Q

PROC ;

 K APCLSKIP

 Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))

 Q:$P(APCLVREC,U,8)=""

 I $G(APCLCLN),APCLCLN'=$P(APCLVREC,U,8) Q

 I APCLLOC]"",APCLLOC'=$P(APCLVREC,U,6) Q

 I APCLPROV,$$PRIMPROV^APCLV(APCLVDFN,"I")'=APCLPROV Q

 ;

 ; ==> go through all of this patients visits from visit date

 ; ==> to 3 days after visit date

 ; ==> APCLIVD=inverse date of vd

 ; ==> APCLFVD=inverse date of 3 days from then

 ;

 ; => add 3 days to current visit date

 S X1=$P($P(APCLVREC,U),"."),X2=3 D C^%DTC S APCL3D=X

 ; => calculate starting point for $O

 S APCLFVD=((9999999-APCL3D)-1)_".9999"

 S APCLIVD=9999999-$P($P(APCLVREC,U),".")

 F  S APCLFVD=$O(^AUPNVSIT("AA",$P(APCLVREC,U,5),APCLFVD)) Q:APCLFVD=""!($P(APCLFVD,".")>APCLIVD)  D

 .S APCLV=0 F  S APCLV=$O(^AUPNVSIT("AA",$P(APCLVREC,U,5),APCLFVD,APCLV)) Q:APCLV'=+APCLV  D

 ..Q:$P(^AUPNVSIT(APCLV,0),U,8)'=APCLERCL

 ..Q:APCLV=APCLVDFN  ;quit if same visit

 ..;S Y=$P(APCLVREC,U) D DD^%DT S APCLT1=$P(Y,"@",2),APCLT1=$TR(APCLT1,":","") ;IHS/CMI/LAB

 ..;S Y=$P(^AUPNVSIT(APCLV,0),U) D DD^%DT S APCLT2=$P(Y,"@",2),APCLT2=$TR(APCLT2,":","") ;IHS/CMI/LAB

 ..S Y=$$FMDIFF^XLFDT($P(^AUPNVSIT(APCLV,0),U),$P(APCLVREC,U),2)

 ..I APCLHR=7 Q:Y>259200

 ..I APCLHR=4 Q:Y>172800

 ..;I $P($P(^AUPNVSIT(APCLV,0),U),".")=$P($P(APCLVREC,U),"."),APCLT1>APCLT2 Q

 ..S ^XTMP("APCLER1",APCLJOB,APCLBTH,$P(APCLVREC,U,5),APCLVDFN,APCLV)=""

 Q

EOJ ;

 K APCLVREC,APCLVDFN,APCLV,APCLODAT

 Q

 ;

APCLER11  ; IHS/CMI/LAB - APC REPORT PROCESS ;

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

 +2       ;IHS/CMI/LAB - patch 5 fixed to only use 72 hours

 +3       ;

START     ;

 +1        SET APCLBT=$HOROLOG

 +2        KILL ^XTMP("APCLER1",APCLJOB,APCLBTH)

 +3        DO XTMP^APCLOSUT("APCLER1","PCC - ER RPT 1")

 +4       ;

V         ; Run by visit date

 +1        SET APCLODAT=APCLSD_".9999"

           FOR 

               SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))

               IF APCLODAT=""!((APCLODAT\1)>APCLED)

                   QUIT 

               DO V1

 +2       ;

END       ;

 +1        SET APCLET=$HOROLOG

 +2        DO EOJ

 +3        QUIT 

V1        ;

 +1       ;count only visits with a clinic = the value in APCLCLN

 +2        SET APCLVDFN=""

           FOR 

               SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVDFN))

               IF APCLVDFN'=+APCLVDFN

                   QUIT 

               IF $DATA(^AUPNVSIT(APCLVDFN,0))

                   IF $PIECE(^(0),U,9)

                       IF '$PIECE(^(0),U,11)

                           SET APCLVREC=^(0)

                           DO PROC

 +3        QUIT 

PROC      ;

 +1        KILL APCLSKIP

 +2        IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))

               QUIT 

 +3        IF $PIECE(APCLVREC,U,8)=""

               QUIT 

 +4        IF $GET(APCLCLN)

               IF APCLCLN'=$PIECE(APCLVREC,U,8)

                   QUIT 

 +5        IF APCLLOC]""

               IF APCLLOC'=$PIECE(APCLVREC,U,6)

                   QUIT 

 +6        IF APCLPROV

               IF $$PRIMPROV^APCLV(APCLVDFN,"I")'=APCLPROV

                   QUIT 

 +7       ;

 +8       ; ==> go through all of this patients visits from visit date

 +9       ; ==> to 3 days after visit date

 +10      ; ==> APCLIVD=inverse date of vd

 +11      ; ==> APCLFVD=inverse date of 3 days from then

 +12      ;

 +13      ; => add 3 days to current visit date

 +14       SET X1=$PIECE($PIECE(APCLVREC,U),".")

           SET X2=3

           DO C^%DTC

           SET APCL3D=X

 +15      ; => calculate starting point for $O

 +16       SET APCLFVD=((9999999-APCL3D)-1)_".9999"

 +17       SET APCLIVD=9999999-$PIECE($PIECE(APCLVREC,U),".")

 +18       FOR 

               SET APCLFVD=$ORDER(^AUPNVSIT("AA",$PIECE(APCLVREC,U,5),APCLFVD))

               IF APCLFVD=""!($PIECE(APCLFVD,".")>APCLIVD)

                   QUIT 

               Begin DoDot:1

 +19               SET APCLV=0

                   FOR 

                       SET APCLV=$ORDER(^AUPNVSIT("AA",$PIECE(APCLVREC,U,5),APCLFVD,APCLV))

                       IF APCLV'=+APCLV

                           QUIT 

                       Begin DoDot:2

 +20                       IF $PIECE(^AUPNVSIT(APCLV,0),U,8)'=APCLERCL

                               QUIT 

 +21      ;quit if same visit

                           IF APCLV=APCLVDFN

                               QUIT 

 +22      ;S Y=$P(APCLVREC,U) D DD^%DT S APCLT1=$P(Y,"@",2),APCLT1=$TR(APCLT1,":","") ;IHS/CMI/LAB

 +23      ;S Y=$P(^AUPNVSIT(APCLV,0),U) D DD^%DT S APCLT2=$P(Y,"@",2),APCLT2=$TR(APCLT2,":","") ;IHS/CMI/LAB

 +24                       SET Y=$$FMDIFF^XLFDT($PIECE(^AUPNVSIT(APCLV,0),U),$PIECE(APCLVREC,U),2)

 +25                       IF APCLHR=7

                               IF Y>259200

                                   QUIT 

 +26                       IF APCLHR=4

                               IF Y>172800

                                   QUIT 

 +27      ;I $P($P(^AUPNVSIT(APCLV,0),U),".")=$P($P(APCLVREC,U),"."),APCLT1>APCLT2 Q

 +28                       SET ^XTMP("APCLER1",APCLJOB,APCLBTH,$PIECE(APCLVREC,U,5),APCLVDFN,APCLV)=""

                       End DoDot:2

               End DoDot:1

 +29       QUIT 

EOJ       ;

 +1        KILL APCLVREC,APCLVDFN,APCLV,APCLODAT

 +2        QUIT 

 +3       ;