source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOVRPT.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.6 KB
RevLine 
[613]1PSOVRPT ;BHAM ISC/SAB - log of non-verified rx's sorted by patient or user code ; 06/29/92 16:56
2 ;;7.0;OUTPATIENT PHARMACY;;DEC 1997
3SORT S DIR("A")="Sort By Patient or Clerk: ",DIR("B")="P",DIR(0)="SA^P:PATIENT;C:CLERK" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S PSOQUIT=1 G END
4 S PSRT=Y
5 K IOP,%ZIS S PSOION=ION,%ZIS="MQ" D ^%ZIS I POP S IOP=PSOION D ^%ZIS K PSOION S PSOQUIT=1 G END
6 I $D(IO("Q")) S ZTRTN="START^PSOVRPT",ZTDESC="REPORT OF NON-VERIFIED RXs SORTED BY PATIENT OR CLERK",ZTSAVE("PSRT")="" D ^%ZTLOAD W:$D(ZTSK) !,"Task Queued " K PSOION,ZTSK S PSOQUIT=1 G END
7START U IO
8 N PAGE,PSOQUIT,LINE,ZPAT,CLERK,RDATE,ZCLK,ZZZZ,PNAME,COUNT,ZZZ,ZSORT,PATNAME,EOFLAG,IDATE,CLNAME,CLINT,PNODE,PSOCT,SSS
9 K ^TMP($J,"PSOVR"),^TMP($J,"PSOCR") S PAGE=1,PSOQUIT=0,$P(LINE,"-",79)=""
10 D NOW^%DTC S Y=% X ^DD("DD") S RDATE=Y
11 I $G(PSRT)="C" G CLERK
12PAT ;sort by patient
13 F ZPAT=0:0 S ZPAT=$O(^PS(52.4,"C",ZPAT)) Q:'ZPAT S COUNT=0 F ZZZ=0:0 S ZZZ=$O(^PS(52.4,"C",ZPAT,ZZZ)) Q:'ZZZ S PATNAME=$P($G(^DPT(ZPAT,0)),"^") D:PATNAME'=""&($D(^PS(52.4,ZZZ,0)))
14 .I $G(ZSORT),$P($G(^PS(52.4,ZZZ,0)),"^",3)'=$G(CLINT) Q
15 .I $D(^PSRX(ZZZ,0)) S COUNT=COUNT+1,^TMP($J,"PSOVR",PATNAME,COUNT)=ZZZ_"^"_$P($G(^PSDRUG(+$P(^PSRX(ZZZ,0),"^",6),0)),"^")_"^"_$P(^PSRX(ZZZ,0),"^",13)_"^"_$P(^PS(52.4,ZZZ,0),"^",3)
16 I $G(ZSORT) Q
17 D HD I '$D(^TMP($J,"PSOVR")) W !!,"NO NON-VERIFIED PRESCRIPTIONS TO PRINT.",! D:$E(IOST)="C" G END
18 .K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
19CLPT ;
20 S PNAME="" F S PNAME=$O(^TMP($J,"PSOVR",PNAME)) Q:PNAME=""!(PSOQUIT) S PSOCT=0 F SSS=0:0 S SSS=$O(^TMP($J,"PSOVR",PNAME,SSS)) Q:'SSS!(PSOQUIT) D
21 .S PSOCT=PSOCT+1,PNODE=^TMP($J,"PSOVR",PNAME,SSS)
22 .S EOFLAG=0 I ($Y+5)>IOSL D Q:PSOQUIT
23 ..I $E(IOST)="C" W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR S:'Y PSOQUIT=1 I 'PSOQUIT S EOFLAG=1 D HD
24 ..I $E(IOST)'="C" S EOFLAG=1 D HD
25 .S ZZZZ=0 I PSOCT=1 W !!?3,PNAME S ZZZZ=1
26 .I 'ZZZZ,$G(EOFLAG) W !!?3,PNAME_" (continued)"
27 .W !,$P($G(^PSRX(+$P(PNODE,"^"),0)),"^")
28 .S IDATE=$P(PNODE,"^",3) W ?13,$E(IDATE,4,5)_"/"_$E(IDATE,6,7)_"/"_$E(IDATE,2,3),?22,$S($O(^PS(52.4,"ADI",+$P(PNODE,"^"),0)):"#",1:" "),$P(PNODE,"^",2)
29 .I $G(PSRT)="P" W ?63,$J(+$P(PNODE,"^",4),15)
30 Q:$G(PSRT)="C"
31 G END
32 ;
33CLERK ;sort by clerk
34 F ZCLK=0:0 S ZCLK=$O(^PS(52.4,"D",ZCLK)) Q:'ZCLK S COUNT=0 F ZZZ=0:0 S ZZZ=$O(^PS(52.4,"D",ZCLK,ZZZ)) Q:'ZZZ D:$P($G(^VA(200,ZCLK,0)),"^")'=""&($D(^PS(52.4,ZZZ,0)))
35 .S CLERK=$P($G(^VA(200,+$P($G(^PS(52.4,ZZZ,0)),"^",3),0)),"^")
36 .I $D(^PSRX(ZZZ,0)),CLERK'="" S ^TMP($J,"PSOCR",CLERK,ZCLK)=""
37 I '$D(^TMP($J,"PSOCR")) D HD W !!,"NO NON-VERIFIED PRESCRIPTIONS TO PRINT.",! D:$E(IOST)="C" G END
38 .K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
39 S CLNAME="" F S CLNAME=$O(^TMP($J,"PSOCR",CLNAME)) Q:CLNAME=""!(PSOQUIT) S CLINT=$O(^TMP($J,"PSOCR",CLNAME,0)) D
40 .S ZSORT=1 D PAT D:$D(^TMP($J,"PSOVR")) HD D:$D(^TMP($J,"PSOVR")) CLPT D:$E(IOST)="C"&('$G(PSOQUIT)) K ZSORT,^TMP($J,"PSOVR")
41 ..K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue,'^' to exit" D ^DIR K DIR S:Y'=1 PSOQUIT=1 Q
42END D:$E(IOST)="C"&($G(PSRT)="P")&('$G(PSOQUIT)) K ^TMP($J,"PSOVR"),^TMP($J,"PSOCR") K PSRT W:$E(IOST)="P" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" Q
43 .W ! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
44 ;
45HD W:$G(PAGE)'=1!($E(IOST)="C") @IOF W !?29,"NON-VERIFIED PRESCRIPTIONS",!?29,"AS OF "_$G(RDATE),!,?34,"SORTED BY "_$S($G(PSRT)="P":"PATIENT",1:"CLERK"),!?22,"(# indicates Critical Drug Interaction)"
46 W !?3,"Patient name",?70,"Page: ",$G(PAGE),!,"Rx #",?13,"Issued",?23,"Drug" D:$G(PSRT)="C" W:$G(PSRT)="P" ?70,"Entry By" W !,LINE S PAGE=PAGE+1
47 .W ?35,"CLERK-> "_$G(CLNAME)
48 Q
Note: See TracBrowser for help on using the repository browser.