APCL1H1.m

APCL1H1 ; IHS/CMI/LAB - Inpatient 2A report process ;

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

 S APCLBT=$H,APCLJOB=$J

 K ^XTMP("APCL1H",APCLJOB,APCLBT)

 D XTMP^APCLOSUT("APCL1H","PCC HOSPITALIZATION COUNT RPT APCL1H")

 S APCLSD=APCLFY-.0001 S X1=APCLFY,X2=365 D C^%DTC S APCLFYE=$E(X,1,3)_"0930"

LOC S APCLJ=0 F  S APCLJ=$O(^AUTTLOC(APCLJ)) Q:APCLJ'=+APCLJ  S:$P(^AUTTLOC(APCLJ,0),U,4)=APCLAREA ^XTMP("APCL1H",APCLJOB,APCLBT,"LOCATIONS",APCLJ)=""

V ; Run by visit date

 S APCLGRAN=0

 S APCLODAT=APCLSD F  S APCLODAT=$O(^AUPNVINP("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLFYE)  D V1

 S APCLET=$H

 Q

V1 ;

 S APCLVINP="" F  S APCLVINP=$O(^AUPNVINP("B",APCLODAT,APCLVINP)) Q:APCLVINP'=+APCLVINP  I $D(^AUPNVINP(APCLVINP,0)) S APCLHREC=^(0) D PROC,EOJ

 Q

PROC ;

 Q:$$DEMO^APCLUTL($P(APCLHREC,U,2),$G(APCLDEMO))

 S APCLVDFN=$P(APCLHREC,U,3)

 S APCLVREC=^AUPNVSIT(APCLVDFN,0)

 Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3)))  ;LAB/TUCSON CHANGED FOR VA

 S APCLVLOC=$P(APCLVREC,U,6)

 Q:'$D(^XTMP("APCL1H",APCLJOB,APCLBT,"LOCATIONS",APCLVLOC))

 Q:'$D(^AUPNVPOV("AD",APCLVDFN))

 Q:'$D(^AUPNVPRV("AD",APCLVDFN))

PROC1 S (APCL1,APCL2)=0 F  S APCL2=$O(^AUPNVPRV("AD",APCLVDFN,APCL2)) Q:APCL2=""  I $P(^AUPNVPRV(APCL2,0),U,4)="P" S APCL1=APCL1+1

 Q:APCL1=0

 Q:APCL1>1

 S APCLMOS=+$E(APCLODAT,4,5)

 S ^(APCLMOS)=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLVLOC,APCLMOS)):^(APCLMOS)+1,1:1)

 S ^(APCLVLOC)=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"LOCTOT",APCLVLOC)):^(APCLVLOC)+1,1:1)

 S APCLGRAN=APCLGRAN+1

 Q

EOJ K APCLVLOC,APCLHREC,APCL1,APCL2,APCLVREC,APCLVDFN

 Q

 ;

APCL1H1   ; IHS/CMI/LAB - Inpatient 2A report process ;

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

 +2        SET APCLBT=$HOROLOG

           SET APCLJOB=$JOB

 +3        KILL ^XTMP("APCL1H",APCLJOB,APCLBT)

 +4        DO XTMP^APCLOSUT("APCL1H","PCC HOSPITALIZATION COUNT RPT APCL1H")

 +5        SET APCLSD=APCLFY-.0001

           SET X1=APCLFY

           SET X2=365

           DO C^%DTC

           SET APCLFYE=$EXTRACT(X,1,3)_"0930"

LOC        SET APCLJ=0

           FOR 

               SET APCLJ=$ORDER(^AUTTLOC(APCLJ))

               IF APCLJ'=+APCLJ

                   QUIT 

               IF $PIECE(^AUTTLOC(APCLJ,0),U,4)=APCLAREA

                   SET ^XTMP("APCL1H",APCLJOB,APCLBT,"LOCATIONS",APCLJ)=""

V         ; Run by visit date

 +1        SET APCLGRAN=0

 +2        SET APCLODAT=APCLSD

           FOR 

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

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

                   QUIT 

               DO V1

 +3        SET APCLET=$HOROLOG

 +4        QUIT 

V1        ;

 +1        SET APCLVINP=""

           FOR 

               SET APCLVINP=$ORDER(^AUPNVINP("B",APCLODAT,APCLVINP))

               IF APCLVINP'=+APCLVINP

                   QUIT 

               IF $DATA(^AUPNVINP(APCLVINP,0))

                   SET APCLHREC=^(0)

                   DO PROC

                   DO EOJ

 +2        QUIT 

PROC      ;

 +1        IF $$DEMO^APCLUTL($PIECE(APCLHREC,U,2),$GET(APCLDEMO))

               QUIT 

 +2        SET APCLVDFN=$PIECE(APCLHREC,U,3)

 +3        SET APCLVREC=^AUPNVSIT(APCLVDFN,0)

 +4       ;LAB/TUCSON CHANGED FOR VA

           IF $DATA(^APCLCNTL(4,11,"B",$PIECE(APCLVREC,U,3)))

               QUIT 

 +5        SET APCLVLOC=$PIECE(APCLVREC,U,6)

 +6        IF '$DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"LOCATIONS",APCLVLOC))

               QUIT 

 +7        IF '$DATA(^AUPNVPOV("AD",APCLVDFN))

               QUIT 

 +8        IF '$DATA(^AUPNVPRV("AD",APCLVDFN))

               QUIT 

PROC1      SET (APCL1,APCL2)=0

           FOR 

               SET APCL2=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCL2))

               IF APCL2=""

                   QUIT 

               IF $PIECE(^AUPNVPRV(APCL2,0),U,4)="P"

                   SET APCL1=APCL1+1

 +1        IF APCL1=0

               QUIT 

 +2        IF APCL1>1

               QUIT 

 +3        SET APCLMOS=+$EXTRACT(APCLODAT,4,5)

 +4        SET ^(APCLMOS)=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLVLOC,APCLMOS)):^(APCLMOS)+1,1:1)

 +5        SET ^(APCLVLOC)=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"LOCTOT",APCLVLOC)):^(APCLVLOC)+1,1:1)

 +6        SET APCLGRAN=APCLGRAN+1

 +7        QUIT 

EOJ        KILL APCLVLOC,APCLHREC,APCL1,APCL2,APCLVREC,APCLVDFN

 +1        QUIT 

 +2       ;