- PSAHIS ;BIR/LTL,JMB-Drug Transaction History ;7/23/97
- ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15,73**; 10/24/97;Build 3
- ;This routine prints a report of all or specific drugs in a pharmacy
- ;location for a user-specified number of days.
- ;
- ;References to ^PSDRUG( are covered by IA #2095
- ;
- LOC ;Gets locations & drugs to print
- S (PSACNT,PSAOUT)=0 D ^PSAUTL3 G:PSAOUT EXIT1
- S PSACNT=0,PSACHK=$O(PSALOC(""))
- I PSACHK="",'PSALOC W !,"There are no active pharmacy locations." G EXIT1
- W ! S PSALOCN="" F S PSALOCN=$O(PSALOC(PSALOCN)) Q:PSALOCN=""!(PSAOUT) S PSALOC=0 F S PSALOC=$O(PSALOC(PSALOCN,PSALOC)) Q:'PSALOC!(PSAOUT) D
- .W @IOF W:$L(PSALOCN)>79 !,$P(PSALOCN,"(IP)",1)_"(IP)",!?17,$P(PSALOCN,"(IP)",2) W:$L(PSALOCN)<80 !,PSALOCN
- .D DRUG Q:PSAOUT Q:X["^A"
- G:PSAOUT EXIT G DAYS
- DRUG ;Gets drugs to print
- W !!,"You may select one, several, or ^ALL drugs."
- F S DIC="^PSD(58.8,"_+PSALOC_",1,",DIC(0)="AEMQ",DIC("A")="Select Drug: " D Q:PSAOUT!(Y<0)!(X["^A")
- .D ^DIC K DIC I X'["^A"&(Y<1)&('PSACNT) S PSAOUT=1 Q
- .I X["^A" D ALL^PSAHIS1 Q
- .Q:Y<0 I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
- .S ^TMP("PSADRG",$J,PSALOC,$P($G(^PSDRUG(+Y,0)),"^"),+Y)="" S PSACNT=PSACNT+1
- .I PSACNT=1,'$O(^PSD(58.81,"F",+$O(^TMP("PSADRG",$J,PSALOC,$P($G(^PSDRUG(+Y,0)),"^"),0)),0)) W !!,"There have been no transactions for this drug.",!
- I '$D(PSALOC) W !!,"There are no drugs in all the selected location(s)." G EXIT
- Q
- ;
- DAYS G:$O(^TMP("PSADRG",$J,""))="" EXIT
- S DIR(0)="D:AEP",DIR("A")="How many days back do you want to search for the drug: ",DIR("B")="T-6M",DIR("?")="I will list transactions for your selected drug(s) within the last six months if you press return" W ! D ^DIR K DIR
- S PSABDT=Y G:$G(DIRUT) EXIT
- ;
- DEV ;Asks device & queueing info
- K IO("Q") N %ZIS,IOP,POP S %ZIS="Q" W !
- D ^%ZIS I POP W !,"NO DEVICE SELECTED OR OUTPUT PRINTED!" G EXIT ;;<*73 - RJS
- I $D(IO("Q")) D G EXIT
- .N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
- .S ZTRTN="START^PSAHIS",ZTDESC="Drug Acct.-Drug Transaction History"
- .S ZTSAVE("PSALOC(")="",ZTSAVE("PSABDT")="",ZTSAVE("^TMP(""PSADRG"",$J,")="" D ^%ZTLOAD
- ;
- START ;Compiles & prints output data
- S PSARPDT=$E($$HTFM^XLFDT($H),1,12),PSADT=$P(PSARPDT,"."),PSATM=$P(PSARPDT,".",2)
- S PSARPDT=$E(PSADT,4,5)_"-"_$E(PSADT,6,7)_"-"_$E(PSADT,2,3),PSARUN=PSARPDT_"@"_PSATM
- S PSADLN="=====================================|==========|=====|=====|==========|========"
- S PSABDTR=$E(PSABDT,4,5)_"-"_$E(PSABDT,6,7)_"-"_$E(PSABDT,2,3),PSAOUT=0
- S PSALOCN="" F S PSALOCN=$O(PSALOC(PSALOCN)) Q:PSALOCN="" D G:PSAOUT EXIT
- .S PSALOC=0 F S PSALOC=$O(PSALOC(PSALOCN,PSALOC)) Q:'PSALOC D SITES^PSAUTL1,FIND Q:PSAOUT
- ;
- EXIT W:$E(IOST,1,2)="C-" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- K IO("Q"),^TMP("PSA",$J),^TMP("PSADRG",$J),^TMP("PSAHIS",$J),PSALOC,PSALOCA,PSALOCN
- ;G:'PSAOUT LOC
- EXIT1 K %ZIS,DIC,DIR,DIRUT,DTOUT,DUOUT,PSA50,PSABAD,PSABAD1,PSABAL,PSABDT,PSABDTR,PSACHK,PSACNT,PSACOMB,PSADJT,PSADJDT,PSADLN,PSADRG,PSADRUG,PSADT
- K PSAFIRST,PSAHOLD,PSAHOLDN,PSAIPT,PSAISIT,PSAISITN,PSALN,PSALOC,PSALOCA,PSALOCN,PSANONE,PSAOPT,PSAOSIT,PSAOSITN,PSAOUT,PSAPC,PSAPC1,PSAPCS,PSAPG
- K PSAREA,PSARECT,PSARPDT,PSARPDT,PSARUN,PSAS,PSASEL,PSASITES,PSASS,PSATM,PSATR,PSATR0,PSATRANL,PSATRCNT,PSAWRT,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- Q
- FIND ;Finds drugs & puts in alpha order in ^TMP("PSAHIS",$J)
- K ^TMP("PSAHIS",$J),^TMP("PSA",$J),PSAFIRST
- S (PSACNT,PSAPG)=0,PSADRG=""
- F S PSADRG=$O(^TMP("PSADRG",$J,PSALOC,PSADRG)) Q:PSADRG="" S (PSABAD,PSA50)=0 F S PSA50=$O(^TMP("PSADRG",$J,PSALOC,PSADRG,PSA50)) Q:'PSA50 D
- .;I '$G(PSATR),$O(^TMP("PSADRG",$J,PSALOC,PSADRG,0)) S PSA50=$O(^TMP("PSADRG",$J,PSALOC,PSADRG,0))
- .S (PSAFIRST,PSATR)=0 F S PSATR=+$O(^PSD(58.81,"F",PSA50,PSATR)) Q:'PSATR!(PSAOUT) D Q:PSAOUT
- ..S PSATR0=$G(^PSD(58.81,PSATR,0)) Q:$P(PSATR0,"^",3)'=PSALOC
- ..I $P(PSATR0,"^",4)'<PSABDT S ^TMP("PSAHIS",$J,PSADRG,$E($P(PSATR0,"^",4),1,7),PSATR)="" S:'PSAFIRST PSAFIRST=PSATR,^TMP("PSA",$J,PSADRG)=PSATR Q
- ..I PSAFIRST,PSATR>PSAFIRST S PSABAD1=$S($P(PSATR0,"^",2)=2!($P(PSATR0,"^",2)=15)!($P(PSATR0,"^",2)=6):-$P(PSATR0,"^",6),1:$P(PSATR0,"^",6)) S PSABAD(PSADRG)=$G(PSABAD(PSADRG))+PSABAD1
- I $D(^TMP("PSAHIS",$J)) D ^PSAHIS1 Q
- I '$D(^TMP("PSAHIS",$J)) W !!,"No transactions were found for the pharmacy location." H 1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAHIS 4340 printed Feb 18, 2025@23:15:44 Page 2
- PSAHIS ;BIR/LTL,JMB-Drug Transaction History ;7/23/97
- +1 ;;3.0;DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,15,73**; 10/24/97;Build 3
- +2 ;This routine prints a report of all or specific drugs in a pharmacy
- +3 ;location for a user-specified number of days.
- +4 ;
- +5 ;References to ^PSDRUG( are covered by IA #2095
- +6 ;
- LOC ;Gets locations & drugs to print
- +1 SET (PSACNT,PSAOUT)=0
- DO ^PSAUTL3
- if PSAOUT
- GOTO EXIT1
- +2 SET PSACNT=0
- SET PSACHK=$ORDER(PSALOC(""))
- +3 IF PSACHK=""
- IF 'PSALOC
- WRITE !,"There are no active pharmacy locations."
- GOTO EXIT1
- +4 WRITE !
- SET PSALOCN=""
- FOR
- SET PSALOCN=$ORDER(PSALOC(PSALOCN))
- if PSALOCN=""!(PSAOUT)
- QUIT
- SET PSALOC=0
- FOR
- SET PSALOC=$ORDER(PSALOC(PSALOCN,PSALOC))
- if 'PSALOC!(PSAOUT)
- QUIT
- Begin DoDot:1
- +5 WRITE @IOF
- if $LENGTH(PSALOCN)>79
- WRITE !,$PIECE(PSALOCN,"(IP)",1)_"(IP)",!?17,$PIECE(PSALOCN,"(IP)",2)
- if $LENGTH(PSALOCN)<80
- WRITE !,PSALOCN
- +6 DO DRUG
- if PSAOUT
- QUIT
- if X["^A"
- QUIT
- End DoDot:1
- +7 if PSAOUT
- GOTO EXIT
- GOTO DAYS
- DRUG ;Gets drugs to print
- +1 WRITE !!,"You may select one, several, or ^ALL drugs."
- +2 FOR
- SET DIC="^PSD(58.8,"_+PSALOC_",1,"
- SET DIC(0)="AEMQ"
- SET DIC("A")="Select Drug: "
- Begin DoDot:1
- +3 DO ^DIC
- KILL DIC
- IF X'["^A"&(Y<1)&('PSACNT)
- SET PSAOUT=1
- QUIT
- +4 IF X["^A"
- DO ALL^PSAHIS1
- QUIT
- +5 if Y<0
- QUIT
- IF $GET(DTOUT)!($GET(DUOUT))
- SET PSAOUT=1
- QUIT
- +6 SET ^TMP("PSADRG",$JOB,PSALOC,$PIECE($GET(^PSDRUG(+Y,0)),"^"),+Y)=""
- SET PSACNT=PSACNT+1
- +7 IF PSACNT=1
- IF '$ORDER(^PSD(58.81,"F",+$ORDER(^TMP("PSADRG",$JOB,PSALOC,$PIECE($GET(^PSDRUG(+Y,0)),"^"),0)),0))
- WRITE !!,"There have been no transactions for this drug.",!
- End DoDot:1
- if PSAOUT!(Y<0)!(X["^A")
- QUIT
- +8 IF '$DATA(PSALOC)
- WRITE !!,"There are no drugs in all the selected location(s)."
- GOTO EXIT
- +9 QUIT
- +10 ;
- DAYS if $ORDER(^TMP("PSADRG",$JOB,""))=""
- GOTO EXIT
- +1 SET DIR(0)="D:AEP"
- SET DIR("A")="How many days back do you want to search for the drug: "
- SET DIR("B")="T-6M"
- SET DIR("?")="I will list transactions for your selected drug(s) within the last six months if you press return"
- WRITE !
- DO ^DIR
- KILL DIR
- +2 SET PSABDT=Y
- if $GET(DIRUT)
- GOTO EXIT
- +3 ;
- DEV ;Asks device & queueing info
- +1 KILL IO("Q")
- NEW %ZIS,IOP,POP
- SET %ZIS="Q"
- WRITE !
- +2 ;;<*73 - RJS
- DO ^%ZIS
- IF POP
- WRITE !,"NO DEVICE SELECTED OR OUTPUT PRINTED!"
- GOTO EXIT
- +3 IF $DATA(IO("Q"))
- Begin DoDot:1
- +4 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTDTH,ZTSK
- +5 SET ZTRTN="START^PSAHIS"
- SET ZTDESC="Drug Acct.-Drug Transaction History"
- +6 SET ZTSAVE("PSALOC(")=""
- SET ZTSAVE("PSABDT")=""
- SET ZTSAVE("^TMP(""PSADRG"",$J,")=""
- DO ^%ZTLOAD
- End DoDot:1
- GOTO EXIT
- +7 ;
- START ;Compiles & prints output data
- +1 SET PSARPDT=$EXTRACT($$HTFM^XLFDT($HOROLOG),1,12)
- SET PSADT=$PIECE(PSARPDT,".")
- SET PSATM=$PIECE(PSARPDT,".",2)
- +2 SET PSARPDT=$EXTRACT(PSADT,4,5)_"-"_$EXTRACT(PSADT,6,7)_"-"_$EXTRACT(PSADT,2,3)
- SET PSARUN=PSARPDT_"@"_PSATM
- +3 SET PSADLN="=====================================|==========|=====|=====|==========|========"
- +4 SET PSABDTR=$EXTRACT(PSABDT,4,5)_"-"_$EXTRACT(PSABDT,6,7)_"-"_$EXTRACT(PSABDT,2,3)
- SET PSAOUT=0
- +5 SET PSALOCN=""
- FOR
- SET PSALOCN=$ORDER(PSALOC(PSALOCN))
- if PSALOCN=""
- QUIT
- Begin DoDot:1
- +6 SET PSALOC=0
- FOR
- SET PSALOC=$ORDER(PSALOC(PSALOCN,PSALOC))
- if 'PSALOC
- QUIT
- DO SITES^PSAUTL1
- DO FIND
- if PSAOUT
- QUIT
- End DoDot:1
- if PSAOUT
- GOTO EXIT
- +7 ;
- EXIT if $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 KILL IO("Q"),^TMP("PSA",$JOB),^TMP("PSADRG",$JOB),^TMP("PSAHIS",$JOB),PSALOC,PSALOCA,PSALOCN
- +2 ;G:'PSAOUT LOC
- EXIT1 KILL %ZIS,DIC,DIR,DIRUT,DTOUT,DUOUT,PSA50,PSABAD,PSABAD1,PSABAL,PSABDT,PSABDTR,PSACHK,PSACNT,PSACOMB,PSADJT,PSADJDT,PSADLN,PSADRG,PSADRUG,PSADT
- +1 KILL PSAFIRST,PSAHOLD,PSAHOLDN,PSAIPT,PSAISIT,PSAISITN,PSALN,PSALOC,PSALOCA,PSALOCN,PSANONE,PSAOPT,PSAOSIT,PSAOSITN,PSAOUT,PSAPC,PSAPC1,PSAPCS,PSAPG
- +2 KILL PSAREA,PSARECT,PSARPDT,PSARPDT,PSARUN,PSAS,PSASEL,PSASITES,PSASS,PSATM,PSATR,PSATR0,PSATRANL,PSATRCNT,PSAWRT,X,Y,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- +3 QUIT
- FIND ;Finds drugs & puts in alpha order in ^TMP("PSAHIS",$J)
- +1 KILL ^TMP("PSAHIS",$JOB),^TMP("PSA",$JOB),PSAFIRST
- +2 SET (PSACNT,PSAPG)=0
- SET PSADRG=""
- +3 FOR
- SET PSADRG=$ORDER(^TMP("PSADRG",$JOB,PSALOC,PSADRG))
- if PSADRG=""
- QUIT
- SET (PSABAD,PSA50)=0
- FOR
- SET PSA50=$ORDER(^TMP("PSADRG",$JOB,PSALOC,PSADRG,PSA50))
- if 'PSA50
- QUIT
- Begin DoDot:1
- +4 ;I '$G(PSATR),$O(^TMP("PSADRG",$J,PSALOC,PSADRG,0)) S PSA50=$O(^TMP("PSADRG",$J,PSALOC,PSADRG,0))
- +5 SET (PSAFIRST,PSATR)=0
- FOR
- SET PSATR=+$ORDER(^PSD(58.81,"F",PSA50,PSATR))
- if 'PSATR!(PSAOUT)
- QUIT
- Begin DoDot:2
- +6 SET PSATR0=$GET(^PSD(58.81,PSATR,0))
- if $PIECE(PSATR0,"^",3)'=PSALOC
- QUIT
- +7 IF $PIECE(PSATR0,"^",4)'<PSABDT
- SET ^TMP("PSAHIS",$JOB,PSADRG,$EXTRACT($PIECE(PSATR0,"^",4),1,7),PSATR)=""
- if 'PSAFIRST
- SET PSAFIRST=PSATR
- SET ^TMP("PSA",$JOB,PSADRG)=PSATR
- QUIT
- +8 IF PSAFIRST
- IF PSATR>PSAFIRST
- SET PSABAD1=$SELECT($PIECE(PSATR0,"^",2)=2!($PIECE(PSATR0,"^",2)=15)!($PIECE(PSATR0,"^",2)=6):-$PIECE(PSATR0,"^",6),1:$PIECE(PSATR0,"^",6))
- SET PSABAD(PSADRG)=$GET(PSABAD(PSADRG))+PSABAD1
- End DoDot:2
- if PSAOUT
- QUIT
- End DoDot:1
- +9 IF $DATA(^TMP("PSAHIS",$JOB))
- DO ^PSAHIS1
- QUIT
- +10 IF '$DATA(^TMP("PSAHIS",$JOB))
- WRITE !!,"No transactions were found for the pharmacy location."
- HANG 1
- +11 QUIT