source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGMMAR.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1PSGMMAR ;BIR/CML3-MULTIPLE DAY MARS - MAIN DRIVER ;14 Oct 98 / 4:28 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**15,20,110,111,131,145**;16 DEC 97;Build 17
3 F R !!,"HOW MANY DAYS? (7/14) ",PSGMARDF:DTIME S:'$T PSGMARDF="^" Q:"^"[PSGMARDF Q:PSGMARDF=7!(PSGMARDF=14) W $C(7)," 7 OR 14 DAY MAR!!"
4 G:"^"[PSGMARDF DONE G EN
5 ;
6EN7 ;
7 S PSGMARDF=7 G EN
8 ;
9EN14 ;
10 S PSGMARDF=14
11 ;
12EN ;
13 NEW DRUGNAME,F,MARLB,NAME,UP,PSGOP
14 D ENCV^PSGSETU G:$D(XQUIT) DONE K PSGMAROF
15 ;
16EN1 ;
17 D MARFORM^PSGMUTL G:'PSGMARB DONE
18 ;
19ENOE ;
20 D SD^PSGMMARH W ! D ^DIR K DIR,DTOUT,DUOUT,DIRUT,DIROUT G:"^"[$E(Y) DONE S PSGMARS=$F("CPBO",Y)-1
21 ;
22DATE ;
23 S %DT="ETSX",Y=-1 F W !!,"Enter START DATE/TIME for "_PSGMARDF_" day MAR: " R X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D:X?1."?" DH^PSGMMARH D ^%DT Q:Y>0
24 I Y'>0 W $C(7),!!?5,"(No date selected, or MAR run.)" G DONE
25 S PSGMARSD=+Y,X1=$P(+Y,"."),X2=PSGMARDF-1 D C^%DTC S PSGMARFD=X
26 D NOW^%DTC S PSGDT=%,(PSGMARWG,PSJPWDO)=0,PSGRBPPN="",PSGMARWD=+$G(PSJPWD)
27 I '$G(PSGMAROF),'$G(PSGOENOF)!($G(PSGSS)="") S (PSGP,PSGPAT,PSGMARWD)=0,PSGSSH="MAR" D ^PSGSEL G:"^"[PSGSS OUT D @PSGSS G:$G(PSJSTOP) OUT
28 I PSGMARB'=1 G:$$MEDTYPE^PSJMDIR(PSGMARWD) OUT S PSGMTYPE=Y
29 D DEV I POP!$D(IO("Q")) G DONE
30 ;
31ENQ ; when queued
32 N DRGI,DRGN,DRGT,LN,P,PSIVUP,PSJORIFN,PSGMSORT
33 D ^PSGMMAR0 I $D(^TMP($J))>9 D ^PSGMMAR1 K ^TMP($J)
34 ;DAM 5-01-07
35 I $D(PSGREP) K ^XTMP(PSGREP)
36 ;END DAM
37 D ^%ZISC G DONE
38 ;
39OUT W $C(7),!!?5,"(No patient(s) selected for MAR run.)" K PSGPLF,PSGPLS
40DONE ;
41 I '$D(PSGOENOF),'$D(PSGVBY) D ENKV^PSGSETU
42 K:'$D(PSGVBY) PSGSS,PSGSSH
43 D ENKV^PSGLOI
44 K AD,ASTERS,BD,BLN,CNTR,DA1,DA2,DAO,DIC,DRG,DX,EXPIRE,FD,HX,L,LN1,LN14,LN2,LN3,LN31,LN32,LN4,LN5,LN6,LN7
45 K MOS,MSG1,MSG2,N,ND2,NAMENEED,NEED,OPST,PSJJORD,PAGE,PN,PND,PNN,PPN,PRB,PSEX,PSSN,PSGMAPA,PSGMAPB,PSGMAPC,PSGMAPD,PSGADR,PSGALG,PSGS0Y,PSGXDT
46 K PSGD,PSGDW,PSGMAR,PSGMARB,PSGMARDF,PSGMARED,PSGMARGD,PSGMARFD,PSGMARFP,PSGMAROC,PSGMAROF,PSGMARPT,PSGMARS,PSGMARSD,PSGMARSM,PSGMARSP
47 K PSGMARTS,PSGMARWD,PSGMARWG,PSGMARWN,PSGMARWS,PSGMPG,PSGMPGN,PSGORD,PSGPAT,PSJDIET
48 K DFN,NG,NO,ON,PST,PTM,PWDN,QST,PSJACNWP,R,RB,RCT,S,SD,SM,SPACES,TM,T,TD,TS,WD,WDN,WG,WGN,WS,WT,X1,X2,Y1
49 K PSJSTOP,PSJPWDO,PSGMARO,PSGMTYPE,PSGTM,PSGTMALL,XTYPE,PSGLRPH,PSGPG
50 K HT,PSGOENOF,PSGOES,PSGRBPPN,PSGS0XT,PSGST,PSGTIR,PSGWD,XQUIT,ZTDESC,ONHOLD
51 Q
52 ;
53G ;
54 S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select WARD GROUP: " W ! D ^DIC K DIC D I $G(PSJSTOP)=1 Q
55 . I X="^OTHER" S PSGMARWG="^OTHER" Q
56 . S PSGMARWG=+Y
57 . I +Y'>0 S PSJSTOP=1
58 D RBPPN^PSJMDIR
59 Q
60 ;
61W ;
62 S DIC="^DIC(42,",DIC(0)="QEAMI",DIC("A")="Select WARD: " W ! D ^DIC K DIC S PSGMARWD=+Y I +Y<0 S PSJSTOP=1 Q
63 S PSGWD=PSGMARWD D ADMTM^PSJMDIR S Y=PSGMARWD
64 D:'PSJSTOP RBPPN^PSJMDIR
65 Q
66 ;
67P ;
68 K PSGPAT S PSGPAT=0 F CNTR=0:1 S:CNTR PSGDICA="another" D ENP^PSGGAO:'PSGMARB,ENDPT^PSGP:PSGMARB Q:PSGP'>0 D
69 . S PSGPAT(PSGP)="",PSGPAT=PSGP
70 . ;*** PSGMARWD=1 when all patients are select from the same ward.
71 . S:'$G(PSJPWDO) (PSGMARWD,PSJPWDO)=PSJPWD S PSGMARWD=$S('$G(PSGMARWD):0,PSJPWDO=PSJPWD:PSJPWD,1:0)
72 S Y=PSGPAT S:Y'>0 PSJSTOP=1 K PSGDICA
73 Q
74 ;
75C ;
76 ;DAM 5-01-07 Add new variable to hold numerical value of CLINIC
77 S PSGCLNC=""
78 K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
79 S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
80CDIC ;
81 K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y S PSGCLNC=+Y I +Y<0 S PSJSTOP=1 Q
82 W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
83 Q
84L ;
85 K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
86 S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
87LDIC ;
88 K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y I +Y<0 S PSJSTOP=1 Q
89 W:X["?" !!,"Enter the name of the clinic group you want to use to select patients for processing."
90 Q
91DEV ;
92 K ZTSAVE S PSGTIR="ENQ^PSGMMAR",ZTDESC=PSGMARDF_" DAY MAR" F X="PSGMARWG","PSGMARWD","PSGP","PSGPAT(","PSGDT","PSGMARSD","PSGMARFD","PSGSS","PSGMARB","PSGMARDF","PSGMARS","PSGINCL","PSGINCLG","PSGINWD","PSGINWDG" S ZTSAVE(X)=""
93 F X="PSGMTYPE","PSGRBPPN","^TMP($J," S ZTSAVE(X)=""
94 I PSGSS="W" F X="PSGTMALL","PSGTM","PSGTM(" S ZTSAVE(X)=""
95 D ENDEV^PSGTI W:POP !!?3,"No device selected for "_PSGMARDF_" day MAR run." W:$D(ZTSK) !?3,PSGMARDF_" Day MAR Queued!" K ZTSK Q
96 I 'IO("Q") U IO
97 ;
98ENOR S PSGP=+ORVP
99ENLM ;
100 NEW VADM
101 D ENCV^PSGSETU I $D(QUIT) K PSGMARDF Q
102 D ^PSJAC S PSGPAT=1,PSGPAT(PSGP)="",PSGMAROF=1,PSGSS="P" G EN1
Note: See TracBrowser for help on using the repository browser.