- ABSPOS35 ; IHS/FCS/DRS - survey pharmacy volume ;
- ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
- Q
- MAIN ;EP - option: ABSP VOLUME SURVEY
- W !,"Survey of pharmacy volume",!
- N RANGE S RANGE=$$DTR^ABSPOSU1 Q:RANGE<1
- D ^%ZIS
- D VOLUME($P(RANGE,U),$P(RANGE,U,2))
- D ^%ZISC
- Q
- VOLTEST N X1,X2,X,%H S X1=DT,X2=-90 D C^%DTC D VOLUME(X,DT) Q
- VOLUME(STARTDT,THRUDT) ;EP - survey daily volume (via AL and AJ indexes)
- ; Build ^TMP($J,index,date)=how many
- ; ^TMP($J,index)=total
- K ^TMP($J)
- N INDEX,RXI,RXR,WEEKDAY,I,X,DATE,NDAYS,COUNT,WKTOTAL
- N RPTDATE S RPTDATE=$$NOWEXT^ABSPOSU1
- I '$D(THRUDT) S THRUDT=DT
- N YEAR S YEAR=$$YEAR(STARTDT) D HEADING
- S DATE=STARTDT,WKTOTAL=0,NDAYS=0
- F D Q:DATE>THRUDT
- . F INDEX="AL","AJ" D
- . . S COUNT=$$COUNT(DATE,INDEX)
- . . S ^TMP($J,INDEX,DATE)=COUNT
- . . S ^TMP($J,INDEX)=$G(^TMP($J,INDEX))+COUNT
- . . S WKTOTAL=WKTOTAL+COUNT
- . . I INDEX="AL" D
- . . . I $$WKDAY(DATE)=0 W $$MMMDD(DATE)
- . . . W ?$$WKDAY(DATE)+1*8,$J(COUNT,5)
- . . . I $$WKDAY(DATE)=6 W ?70,$J(WKTOTAL,6),! S WKTOTAL=0
- . . . I $$EOPQ^ABSPOSU8(2,,"D HEADING^"_$T(+0)) S DATE=9999999
- . S NDAYS=NDAYS+1
- . S DATE=$$NEXTDAY(DATE) Q:DATE>THRUDT
- . I $$YEAR(DATE)'=YEAR D
- . . S YEAR=$$YEAR(DATE)
- . . D HEADING
- W:$X>0 !
- D EOPQ^ABSPOSU8(4,,"D HEADING^"_$T(+0))
- W "INDEX",?10,"Total",?20,"Average",!
- F INDEX="AL","AJ" D
- . W INDEX,?10,^TMP($J,INDEX)
- . W ?20,$J(^TMP($J,INDEX)/NDAYS,6,1),!
- D ENDRPT^ABSPOSU5()
- Q
- HEADING ;
- W @IOF
- W "Survey of Pharmacy Volume (",$T(+0),")",?60,RPTDATE,!
- W "For " D W !
- . N Y S Y=$P(RANGE,U) X ^DD("DD") W Y
- . W " through "
- . S Y=$P(RANGE,U,2) X ^DD("DD") W Y
- . W !
- W !,YEAR
- F I=0:1:6 W ?I+1*8," ",$P("MON,TUE,WED,THU,FRI,SAT,SUN",",",I+1)
- W ?70,"WK. TOTAL",!
- Q
- COUNT(DATE,INDEX) ;
- N C,D,RXI,RXR S C=0
- S D=DATE F D S D=$O(^PSRX(INDEX,D)) Q:D="" Q:D\1'=DATE
- . S RXI="" F S RXI=$O(^PSRX(INDEX,D,RXI)) Q:RXI="" D
- . . S RXR="" F S RXR=$O(^PSRX(INDEX,D,RXI,RXR)) Q:RXR="" D
- . . . S C=C+1
- Q C
- WKDAY(X) ; given X = Fileman date return 0 = Monday, 1 = Tuesday, etc.
- Q $$DOLLARH(X)+3#7
- DOLLARH(X) ; given X = Fileman date, return $H date
- N %H,%T,%Y D H^%DTC Q %H
- NEXTDAY(X1) ; given X = Fileman date, return next day's Fileman date
- N X2 S X2=1 N X,%H D C^%DTC Q X
- YEAR(Y) X ^DD("DD") Q $P($P(Y,"@"),",",2)
- MMMDD(Y) X ^DD("DD") Q $P(Y,",")
- ABSPOS35 ; IHS/FCS/DRS - survey pharmacy volume ;
- +1 ;;1.0;PHARMACY POINT OF SALE;;JUN 21, 2001
- +2 QUIT
- MAIN ;EP - option: ABSP VOLUME SURVEY
- +1 WRITE !,"Survey of pharmacy volume",!
- +2 NEW RANGE
- SET RANGE=$$DTR^ABSPOSU1
- IF RANGE<1
- QUIT
- +3 DO ^%ZIS
- +4 DO VOLUME($PIECE(RANGE,U),$PIECE(RANGE,U,2))
- +5 DO ^%ZISC
- +6 QUIT
- VOLTEST NEW X1,X2,X,%H
- SET X1=DT
- SET X2=-90
- DO C^%DTC
- DO VOLUME(X,DT)
- QUIT
- VOLUME(STARTDT,THRUDT) ;EP - survey daily volume (via AL and AJ indexes)
- +1 ; Build ^TMP($J,index,date)=how many
- +2 ; ^TMP($J,index)=total
- +3 KILL ^TMP($JOB)
- +4 NEW INDEX,RXI,RXR,WEEKDAY,I,X,DATE,NDAYS,COUNT,WKTOTAL
- +5 NEW RPTDATE
- SET RPTDATE=$$NOWEXT^ABSPOSU1
- +6 IF '$DATA(THRUDT)
- SET THRUDT=DT
- +7 NEW YEAR
- SET YEAR=$$YEAR(STARTDT)
- DO HEADING
- +8 SET DATE=STARTDT
- SET WKTOTAL=0
- SET NDAYS=0
- +9 FOR
- Begin DoDot:1
- +10 FOR INDEX="AL","AJ"
- Begin DoDot:2
- +11 SET COUNT=$$COUNT(DATE,INDEX)
- +12 SET ^TMP($JOB,INDEX,DATE)=COUNT
- +13 SET ^TMP($JOB,INDEX)=$GET(^TMP($JOB,INDEX))+COUNT
- +14 SET WKTOTAL=WKTOTAL+COUNT
- +15 IF INDEX="AL"
- Begin DoDot:3
- +16 IF $$WKDAY(DATE)=0
- WRITE $$MMMDD(DATE)
- +17 WRITE ?$$WKDAY(DATE)+1*8,$JUSTIFY(COUNT,5)
- +18 IF $$WKDAY(DATE)=6
- WRITE ?70,$JUSTIFY(WKTOTAL,6),!
- SET WKTOTAL=0
- +19 IF $$EOPQ^ABSPOSU8(2,,"D HEADING^"_$TEXT(+0))
- SET DATE=9999999
- End DoDot:3
- End DoDot:2
- +20 SET NDAYS=NDAYS+1
- +21 SET DATE=$$NEXTDAY(DATE)
- IF DATE>THRUDT
- QUIT
- +22 IF $$YEAR(DATE)'=YEAR
- Begin DoDot:2
- +23 SET YEAR=$$YEAR(DATE)
- +24 DO HEADING
- End DoDot:2
- End DoDot:1
- IF DATE>THRUDT
- QUIT
- +25 IF $X>0
- WRITE !
- +26 DO EOPQ^ABSPOSU8(4,,"D HEADING^"_$TEXT(+0))
- +27 WRITE "INDEX",?10,"Total",?20,"Average",!
- +28 FOR INDEX="AL","AJ"
- Begin DoDot:1
- +29 WRITE INDEX,?10,^TMP($JOB,INDEX)
- +30 WRITE ?20,$JUSTIFY(^TMP($JOB,INDEX)/NDAYS,6,1),!
- End DoDot:1
- +31 DO ENDRPT^ABSPOSU5()
- +32 QUIT
- HEADING ;
- +1 WRITE @IOF
- +2 WRITE "Survey of Pharmacy Volume (",$TEXT(+0),")",?60,RPTDATE,!
- +3 WRITE "For "
- Begin DoDot:1
- +4 NEW Y
- SET Y=$PIECE(RANGE,U)
- XECUTE ^DD("DD")
- WRITE Y
- +5 WRITE " through "
- +6 SET Y=$PIECE(RANGE,U,2)
- XECUTE ^DD("DD")
- WRITE Y
- +7 WRITE !
- End DoDot:1
- WRITE !
- +8 WRITE !,YEAR
- +9 FOR I=0:1:6
- WRITE ?I+1*8," ",$PIECE("MON,TUE,WED,THU,FRI,SAT,SUN",",",I+1)
- +10 WRITE ?70,"WK. TOTAL",!
- +11 QUIT
- COUNT(DATE,INDEX) ;
- +1 NEW C,D,RXI,RXR
- SET C=0
- +2 SET D=DATE
- FOR
- Begin DoDot:1
- +3 SET RXI=""
- FOR
- SET RXI=$ORDER(^PSRX(INDEX,D,RXI))
- IF RXI=""
- QUIT
- Begin DoDot:2
- +4 SET RXR=""
- FOR
- SET RXR=$ORDER(^PSRX(INDEX,D,RXI,RXR))
- IF RXR=""
- QUIT
- Begin DoDot:3
- +5 SET C=C+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- SET D=$ORDER(^PSRX(INDEX,D))
- IF D=""
- QUIT
- IF D\1'=DATE
- QUIT
- +6 QUIT C
- WKDAY(X) ; given X = Fileman date return 0 = Monday, 1 = Tuesday, etc.
- +1 QUIT $$DOLLARH(X)+3#7
- DOLLARH(X) ; given X = Fileman date, return $H date
- +1 NEW %H,%T,%Y
- DO H^%DTC
- QUIT %H
- NEXTDAY(X1) ; given X = Fileman date, return next day's Fileman date
- +1 NEW X2
- SET X2=1
- NEW X,%H
- DO C^%DTC
- QUIT X
- YEAR(Y) XECUTE ^DD("DD")
- QUIT $PIECE($PIECE(Y,"@"),",",2)
- MMMDD(Y) XECUTE ^DD("DD")
- QUIT $PIECE(Y,",")
