source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOSD.m@ 812

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

initial load of FOIAVistA 6/30/08 version

File size: 5.3 KB
Line 
1PSOSD ;BHAM ISC/SAB - action or informational profile ;11/18/92 18:30
2 ;;7.0;OUTPATIENT PHARMACY;**2,17,155,176**;DEC 1997
3 ;External reference to ^PS(55 supported by DBIA 2228
4 ;External reference to ^PSDRUG( supported by DBIA 221
5 ;External reference to ^PPPPRT9 supported by DBIA 1085
6 ;
7START S X=$$SITE^VASITE,PSOINST=$P(X,"^",3) K X
8 K IOP,DIR S DIR("A")="Action or Informational (A or I): ",DIR("?",1)="Enter 'A' for action profile",DIR("?",2)=" 'I' for informational profile",DIR("?")=" 'E' to EXIT process",DIR("B")="A",DIR(0)="SAM^1:Action;0:Informational;E:Exit"
9 D ^DIR G:Y="E"!($D(DIRUT)) PAT1 S PSTYPE=Y
10 S PSONUM=0 I 'PSTYPE!'$P($G(PSOSYS),"^",6) S PSOPOL=0 G ASK
11 K DIR S DIR("A")="Do you want generate a Polypharmacy report?: ",DIR("?",1)="Enter 'Y' to generate report",DIR("?",2)=" 'N' if you do not want the report",DIR("?")=" 'E' to EXIT process",DIR("B")="NO",DIR(0)="SA^1:YES;0:NO;E:Exit"
12 D ^DIR S PSOPOL=$S(Y:1,1:0) G:Y="E"!($D(DIRUT)) PAT1 G:'PSOPOL ASK
13 K DIR S DIR("A")="Minimum Number of Active Prescriptions",DIR("B")=7,DIR(0)="N^1:100:0" D ^DIR S PSONUM=Y G:$D(DIRUT) PAT1
14 ;
15ASK K DIR S DIR("A")="By Patient, Clinic or Clinic Group (P/C/G): ",DIR("?",1)="Enter 'P' to print by patient ",DIR("?",2)=" 'C' for printing by clinic",DIR("?",3)=" 'G' for printing by clinic group"
16 S DIR("?")=" 'E' to exit process",DIR("B")="P",DIR(0)="SAM^P:Patient;C:Clinic;G:Clinic Group;E:Exit"
17 D ^DIR G:Y="E"!($D(DIRUT)) PAT1 S PSOUT=Y
18 K DIR,DTOUT,DIRUT,DUOUT S DIR("A")="Do you want this Profile to print in 80 column or 132 column: ",DIR("B")="132",DIR(0)="SAM^1:132;8:80;E:Exit"
19 D ^DIR G:Y="E"!($D(DIRUT)) PAT1 S PSORM=$S(Y=1:1,1:0) K DIR,X,Y
20 G:PSOUT="P" ^PSOSD1 G:PSOUT="G" CLSG^PSOSDP
21CLINIC N RSLT K DIR,X,Y R !!,"FOR CLINIC (TYPE 'ALL' FOR ALL CLINICS): ",X:DTIME S:'$T X="^" G:"^"[X EXIT
22 S DIC="^SC(",DIC(0)="QEM",FR="ALL",TO="" I X'="ALL" D ^DIC G CLINIC:Y<0 S (FR,TO)=+Y
23 S %DT="AEFX",%DT("A")="FOR DATE: " D ^%DT G CLINIC:Y<0 S FR=FR_","_Y,TO=TO_","_Y_".2359",PSOT=Y
24CLSG D DAYS^PSOSD1 G:$D(DIRUT) EXIT S X1=DT,X2=-PSDAYS D C^%DTC S PSDATE=X S PSTYPE=$S($D(PSTYPE):PSTYPE,1:0),$P(LINE,"-",132)="-"
25 N PSOBARS,PSOBAR0,PSOBAR1
26 D DEV^PSOSDRAP Q:$D(DTOUT)!($D(DUOUT))
27 S (IOP,APRT)=ION,PSOIOS=IOS D DEVBAR^PSOBMST
28 K PSOION I $D(IO("Q")) S ZTDESC="Outpatient Pharmacy Action Profile",ZTRTN="QUE^PSOSD",ZTSAVE("ZTREQ")="@" D D EXIT G START
29 .F G="FR","TO","LINE","PSOT","APRT","PSOPOL","PSOSYS","PSOINST","PSOBAR0","PSOBAR1","PSOBAR2","PSOPAR","PSOPAR7","PRF","PSDAYS","PSDATE","PSTYPE","PSOSITE","PSDATE","PSDAY","PSONUM","PSORM" S:$D(@G) ZTSAVE(G)=""
30 .S ZTSAVE("DOD*")="" D ^%ZTLOAD W:$D(ZTSK) !,"Report Queued to Print !!",! K:'$G(LM) ZTSK,IO("Q")
31 ;S DISTOP="I $D(DIRUT)"
32 I $P(FR,",",1)'="ALL" D CLINIC^PSOSDRAP
33 I $P(FR,",",1)="ALL" D CLINALL^PSOSDRAP
34 S (X,PSTY)=PSTYPE D EXIT S PSTYPE=PSTY Q:$G(CLSP) G START
35 ;
36PAT N K D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN)
37 S PSDT=PSDATE-1 I '$O(^PS(55,DFN,"P","A",PSDT)) D HD^PSOSD2 Q:$D(DIRUT) W !!?13,">>>> NO PRESCRIPTIONS ON FILE <<<<" G PAT1
38 K ^TMP($J,DFN),^TMP($J,"PRF"),^TMP($J,"ACT")
39 F Z1=0:0 S PSDT=$O(^PS(55,DFN,"P","A",PSDT)) Q:'PSDT D RX
40 I '$D(^TMP($J,"PRF")) D HD^PSOSD2 W !!?13,">>>>> NO CURRENT PRESCRIPTIONS DATA FOUND <<<<<" S X="PPPPRT9" X ^%ZOSF("TEST") D:$T PLP^PPPPRT9(DFN) D PAT1 Q
41 D ^PSOSDP:$G(PSOPOL)&('$D(CLINICX))
42 D HD^PSOSD2:'$D(CLINICX)
43 D ^PSOSD0,PAT1 Q:($D(DIRUT))
44 S X="PPPPRT9" X ^%ZOSF("TEST") I $T D PLP^PPPPRT9(DFN)
45 Q
46RX F J=0:0 S J=$O(^PS(55,DFN,"P","A",PSDT,J)) Q:'J D RX1
47 Q
48RX1 Q:'$D(^PSRX(J,0)) S RXNO=J
49 S RX0=$G(^PSRX(J,0)),$P(RX0,"^",15)=+$G(^("STA")),RX2=$G(^(2)),RX3=$G(^(3)) I RX0]"" D
50 .S DRUG="" S:$D(^PSDRUG(+$P(RX0,"^",6),0)) DRUG=$P(^(0),"^"),CLASS=$P(^(0),"^",2) S:CLASS="" CLASS="zz" I DRUG]"" D STAT^PSOFUNC,STORE
51 .I $G(PSOPOL),$P($G(^PSDRUG(+$P(RX0,"^",6),0)),"^",3)'["S" S:'$D(^TMP($J,DFN)) ^TMP($J,DFN)=0 S:"05"[$E(+$P(RX0,"^",15)) ^TMP($J,DFN)=^TMP($J,DFN)+1,^TMP($J,DFN,DRUG,J)=""
52 Q
53PAT1 K DUPD,DIR,X,Y,CLASS,ZCLASS,DRUG,CLAPP,HDFL,RXN,PSDOB,ADDR,RX,ST,ST0,II,FA,FN,PRI,DIC,PSRENW,PSLC,PI,Z2,Z,P,Z0,Z1,Z3,Z4,Z5,FDATE,AL,RFL,DRG,ELN,FDT,FILLDATE,FN,LN,PSOIFSUP,PSOPRPAS,RX3,RXCNT,SG,SGC,PSOUT,PSOPOLP
54 Q
55 ;
56STORE I $P(^PSRX(J,"STA"),"^")=13!($P($G(^(3)),"^",7)="CANCELLED FROM SUSPENSE BEFORE FILLING")!($P($G(^(3)),"^",7)="DISCONTINUED FROM SUSPENSE BEFORE FILLING") Q
57 I 'PSDAYS,ST]"","DE"[$E(ST) Q
58 S FILLDATE=9999999-$P(^PSRX(J,3),"^") I "DE"[$E(ST) S FILLDATE=FILLDATE+10000
59 I $E(ST)="D" S CNDT=0 F PSIIX=0:0 S PSIIX=$O(^PSRX(J,"A",PSIIX)) Q:'PSIIX I $P($G(^(0)),"^",2)="C",+$P(^(0),"^")>CNDT S CNDT=+$P(^(0),"^")
60 Q:"AHPSDE"'[$E(ST) S ^TMP($J,"PRF",CLASS,DRUG,FILLDATE,J)=$P(RX0,"^",1,14)_"^"_ST_"^"_$S($D(CNDT):CNDT,1:"") S:"AHPS"[$E(ST) ^TMP($J,"ACT",CLASS,DRUG)=""
61 K CNDT Q
62 ;
63EXIT K ^TMP($J,"PRF"),^("ACT"),PSOT,%DT,ADDR,ADDRFL,BY,CLASS,PCLASS,CLDT
64 K CLINICX,CNDT,DFN,DHD,DRUG,FLDS,FR,CLAPP,HDFL,I,II,J,L,LINE,P,POP,PSDATE
65 K PSDAYS,PSDOB,PSIIX,PSNAME,PSSN,PSTYPE,RX,RX0,RX2,RX3,RXN,ST,ST0,TO,VAR,Z1
66 K APRT,DIE,DR,X,Y,DIC,ZTSAVE,PSORM,PSOUT,PSOPOLP,G,LM,PSDT,ZTDESC,ZTRTN,ZTSK
67 K PSOIOS,PSONUM,PSOPOL,RXNO,X1,X2,RSLT,DIR,DIRUT,DTOUT,DUOUT
68 K CS,DOD,GMRVSTR,PAGE,PSOBAR2,PSOBAR3,PSOBAR4,VA,VADM,VAPA,VAIN
69 D ^%ZISC
70 Q
71ACT ;
72 S PSTYPE=1 G START
73INFO ;
74 S PSTYPE=0 G START
75 ;
76QUE ;prints clinics when queued
77 I $P(FR,",",1)'="ALL" D CLINIC^PSOSDRAP
78 I $P(FR,",",1)="ALL" D CLINALL^PSOSDRAP
79 D EXIT
80 Q
Note: See TracBrowser for help on using the repository browser.