APCLRAD1.m

APCLRAD1 ; IHS/CMI/LAB - READMISSIONS REPORT PROCESS ;

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

 ;

START ;

 S APCLBT=$H

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

 D XTMP^APCLOSUT("APCLRAD","PCC READMISSIONS AFTER 30 DAYS RPT")

 ;

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 ;

 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 ;

 Q:$P(APCLVREC,U,7)'="H"

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

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

 ;

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

 ; ==> to 30 days after visit date

 ; ==> APCLIVD=inverse date of vd

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

 ;

 ; => add 30 days to current visit date

 S X1=$P($P(APCLVREC,U),"."),X2=30 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,7)'="H"

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

 ..I APCLLOC,$P(^AUPNVSIT(APCLV,0),U,6)'=APCLLOC Q  ;if only want 1 facility and this visit isn't that facility, quit

 ..S ^XTMP("APCLRAD",APCLJOB,APCLBTH,APCLVDFN,APCLV)=""

 Q

EOJ ;

 K APCLVREC,APCLVDFN,APCLV,APCLODAT,APCLCLN

 Q

 ;

APCLRAD1  ; IHS/CMI/LAB - READMISSIONS REPORT PROCESS ;

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

 +2       ;

START     ;

 +1        SET APCLBT=$HOROLOG

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

 +3        DO XTMP^APCLOSUT("APCLRAD","PCC READMISSIONS AFTER 30 DAYS RPT")

 +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        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

 +2        QUIT 

PROC      ;

 +1        IF $PIECE(APCLVREC,U,7)'="H"

               QUIT 

 +2        IF APCLLOC]""

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

                   QUIT 

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

               QUIT 

 +4       ;

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

 +6       ; ==> to 30 days after visit date

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

 +8       ; ==> APCLFVD=inverse date of 30 days from then

 +9       ;

 +10      ; => add 30 days to current visit date

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

           SET X2=30

           DO C^%DTC

           SET APCL3D=X

 +12      ; => calculate starting point for $O

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

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

 +15       FOR 

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

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

                   QUIT 

               Begin DoDot:1

 +16               SET APCLV=0

                   FOR 

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

                       IF APCLV'=+APCLV

                           QUIT 

                       Begin DoDot:2

 +17                       IF $PIECE(^AUPNVSIT(APCLV,0),U,7)'="H"

                               QUIT 

 +18      ;quit if same visit

                           IF APCLV=APCLVDFN

                               QUIT 

 +19      ;if only want 1 facility and this visit isn't that facility, quit

                           IF APCLLOC

                               IF $PIECE(^AUPNVSIT(APCLV,0),U,6)'=APCLLOC

                                   QUIT 

 +20                       SET ^XTMP("APCLRAD",APCLJOB,APCLBTH,APCLVDFN,APCLV)=""

                       End DoDot:2

               End DoDot:1

 +21       QUIT 

EOJ       ;

 +1        KILL APCLVREC,APCLVDFN,APCLV,APCLODAT,APCLCLN

 +2        QUIT 

 +3       ;