APCLWL11.m

APCLWL11 ; IHS/CMI/LAB - CLINIC HOURLY WORKLOAD REPORT ;

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

DOC ;This is the "processing" routine for the Clinic Hourly Workload

 ;report.  Called from the APCLWL1 routine.

 ;

 ;List of VARIABLES with brief descriptions:

 ;

START ;Start of routine

 S APCLJOB=$J,APCLBT=$H

 D XTMP^APCLOSUT("APCLWL1","PCC CLINIC HOURLY WORKLOAD RPT")

V ;Run by visit date

 S APCLODAT=$O(^AUPNVSIT("B",APCLSD)) I APCLODAT="" S APCLET=$H Q

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

 S APCLET=$H

 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,EOJ

 Q

PROC ;

 Q:"XECIHRT"[$P(APCLVREC,U,7)

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

 Q:$D(^APCLCNTL(4,11,"B",$P(APCLVREC,U,3)))

 S APCLVLOC=$P(APCLVREC,U,6) Q:APCLVLOC=""

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

 I APCLLOC]"",APCLLOC'=APCLVLOC Q

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

 S APCLCLIN=$P(APCLVREC,U,8)

 S X=$$AGE^AUPNPAT($P(APCLVREC,U,5),$P($P(APCLVREC,U),"."))

 I $D(APCLAGET),X>$P(APCLAGET,"-",2) Q

 I $D(APCLAGET),X<$P(APCLAGET,"-") Q

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

 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

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

 I APCL1=0 Q

 I APCL1>1 Q

 S APCLDATE=$P($P(APCLVREC,U),".")

 S APCLSRT2=$E($P($P(APCLVREC,U),".",2),1,2) S:APCLSRT2="" APCLSRT2=12 S APCLSRT2=$S(APCLSRT2=1:10,APCLSRT2=2:20,1:APCLSRT2) S APCLSRT2=+APCLSRT2 S:APCLSRT2=24 APCLSRT2=0

 S ^(APCLSRT2)=$S($D(^XTMP("APCLWL1",APCLJOB,APCLBT,"DATE",APCLDATE,APCLSRT2)):^(APCLSRT2)+1,1:1)

 S ^(APCLSRT2)=$S($D(^XTMP("APCLWL1",APCLJOB,APCLBT,"TIME TOTALS",APCLSRT2)):^(APCLSRT2)+1,1:1)

 Q

EOJ K APCLVLOC,APCLVREC,APCLCLIN,APCL1,APCL2,APCLSRT2,APCLDATE

 Q

APCLWL11  ; IHS/CMI/LAB - CLINIC HOURLY WORKLOAD REPORT ;

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

DOC       ;This is the "processing" routine for the Clinic Hourly Workload

 +1       ;report.  Called from the APCLWL1 routine.

 +2       ;

 +3       ;List of VARIABLES with brief descriptions:

 +4       ;

START     ;Start of routine

 +1        SET APCLJOB=$JOB

           SET APCLBT=$HOROLOG

 +2        DO XTMP^APCLOSUT("APCLWL1","PCC CLINIC HOURLY WORKLOAD RPT")

V         ;Run by visit date

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

           IF APCLODAT=""

               SET APCLET=$HOROLOG

               QUIT 

 +2        SET APCLODAT=APCLSD_".9999"

           FOR 

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

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

                   QUIT 

               DO V1

 +3        SET APCLET=$HOROLOG

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

                           DO EOJ

 +2        QUIT 

PROC      ;

 +1        IF "XECIHRT"[$PIECE(APCLVREC,U,7)

               QUIT 

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

               QUIT 

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

               QUIT 

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

           IF APCLVLOC=""

               QUIT 

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

               QUIT 

 +6        IF APCLLOC]""

               IF APCLLOC'=APCLVLOC

                   QUIT 

 +7        IF APCLCLN]""

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

                   QUIT 

 +8        SET APCLCLIN=$PIECE(APCLVREC,U,8)

 +9        SET X=$$AGE^AUPNPAT($PIECE(APCLVREC,U,5),$PIECE($PIECE(APCLVREC,U),"."))

 +10       IF $DATA(APCLAGET)

               IF X>$PIECE(APCLAGET,"-",2)

                   QUIT 

 +11       IF $DATA(APCLAGET)

               IF X<$PIECE(APCLAGET,"-")

                   QUIT 

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

               QUIT 

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

 +14       IF APCLPROV]""

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

                   QUIT 

 +15       IF APCL1=0

               QUIT 

 +16       IF APCL1>1

               QUIT 

 +17       SET APCLDATE=$PIECE($PIECE(APCLVREC,U),".")

 +18       SET APCLSRT2=$EXTRACT($PIECE($PIECE(APCLVREC,U),".",2),1,2)

           IF APCLSRT2=""

               SET APCLSRT2=12

           SET APCLSRT2=$SELECT(APCLSRT2=1:10,APCLSRT2=2:20,1:APCLSRT2)

           SET APCLSRT2=+APCLSRT2

           IF APCLSRT2=24

               SET APCLSRT2=0

 +19       SET ^(APCLSRT2)=$SELECT($DATA(^XTMP("APCLWL1",APCLJOB,APCLBT,"DATE",APCLDATE,APCLSRT2)):^(APCLSRT2)+1,1:1)

 +20       SET ^(APCLSRT2)=$SELECT($DATA(^XTMP("APCLWL1",APCLJOB,APCLBT,"TIME TOTALS",APCLSRT2)):^(APCLSRT2)+1,1:1)

 +21       QUIT 

EOJ        KILL APCLVLOC,APCLVREC,APCLCLIN,APCL1,APCL2,APCLSRT2,APCLDATE

 +1        QUIT