APCLER21.m

APCLER21 ; IHS/CMI/LAB - ADMITS FROM ER ;

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

 ;

START ;

 S APCLBT=$H

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

 D XTMP^APCLOSUT("APCLER2","PCC - ER REPORT 2")

 ;

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),$$CLINIC^APCLV(APCLVDFN,"C")=30 S APCLVREC=^AUPNVSIT(APCLVDFN,0) D PROC

 Q

PROC ;

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

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

 ; ==> and find an Hospitalization

 ; ==> APCLIVD=inverse date of vd

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

 ;

 ; => subtract 1 day from current visit date

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

 ; => calculate starting point for $O

 S APCLFVD=(9999999-APCL1D)_".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:$$SC^APCLV(APCLV,"I")'="H"

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

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

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

 ..;I $P($P(^AUPNVSIT(APCLV,0),U),".")=$P($P(APCLVREC,U),"."),APCLT1>APCLT2 Q  ;should we check time of 1 visit versus adm time?  -  nah

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

 Q

EOJ ;

 K APCLVREC,APCLVDFN,APCLV,APCLODAT

 Q

 ;

APCLER21  ; IHS/CMI/LAB - ADMITS FROM ER ;

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

 +2       ;

START     ;

 +1        SET APCLBT=$HOROLOG

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

 +3        DO XTMP^APCLOSUT("APCLER2","PCC - ER REPORT 2")

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

                           IF $$CLINIC^APCLV(APCLVDFN,"C")=30

                               SET APCLVREC=^AUPNVSIT(APCLVDFN,0)

                               DO PROC

 +2        QUIT 

PROC      ;

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

               QUIT 

 +2       ; ==> go through all of this patients visits on this visit date

 +3       ; ==> and find an Hospitalization

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

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

 +6       ;

 +7       ; => subtract 1 day from current visit date

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

           SET X2=1

           DO C^%DTC

           SET APCL1D=X

 +9       ; => calculate starting point for $O

 +10       SET APCLFVD=(9999999-APCL1D)_".9999"

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

 +12       FOR 

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

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

                   QUIT 

               Begin DoDot:1

 +13               SET APCLV=0

                   FOR 

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

                       IF APCLV'=+APCLV

                           QUIT 

                       Begin DoDot:2

 +14                       IF $$SC^APCLV(APCLV,"I")'="H"

                               QUIT 

 +15      ;quit if same visit

                           IF APCLV=APCLVDFN

                               QUIT 

 +16                       SET Y=$PIECE(APCLVREC,U)

                           DO DD^%DT

                           SET APCLT1=$PIECE(Y,"@",2)

                           SET APCLT1=$TRANSLATE(APCLT1,":","")

 +17                       SET Y=$PIECE(^AUPNVSIT(APCLV,0),U)

                           DO DD^%DT

                           SET APCLT2=$PIECE(Y,"@",2)

                           SET APCLT2=$TRANSLATE(APCLT2,":","")

 +18      ;I $P($P(^AUPNVSIT(APCLV,0),U),".")=$P($P(APCLVREC,U),"."),APCLT1>APCLT2 Q  ;should we check time of 1 visit versus adm time?  -  nah

 +19                       SET ^XTMP("APCLER2",APCLJOB,APCLBTH,APCLV)=APCLVDFN

                       End DoDot:2

               End DoDot:1

 +20       QUIT 

EOJ       ;

 +1        KILL APCLVREC,APCLVDFN,APCLV,APCLODAT

 +2        QUIT 

 +3       ;