| [613] | 1 | PSGMMAR ;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 | ;
|
|---|
| 6 | EN7 ;
|
|---|
| 7 | S PSGMARDF=7 G EN
|
|---|
| 8 | ;
|
|---|
| 9 | EN14 ;
|
|---|
| 10 | S PSGMARDF=14
|
|---|
| 11 | ;
|
|---|
| 12 | EN ;
|
|---|
| 13 | NEW DRUGNAME,F,MARLB,NAME,UP,PSGOP
|
|---|
| 14 | D ENCV^PSGSETU G:$D(XQUIT) DONE K PSGMAROF
|
|---|
| 15 | ;
|
|---|
| 16 | EN1 ;
|
|---|
| 17 | D MARFORM^PSGMUTL G:'PSGMARB DONE
|
|---|
| 18 | ;
|
|---|
| 19 | ENOE ;
|
|---|
| 20 | D SD^PSGMMARH W ! D ^DIR K DIR,DTOUT,DUOUT,DIRUT,DIROUT G:"^"[$E(Y) DONE S PSGMARS=$F("CPBO",Y)-1
|
|---|
| 21 | ;
|
|---|
| 22 | DATE ;
|
|---|
| 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 | ;
|
|---|
| 31 | ENQ ; 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 | ;
|
|---|
| 39 | OUT W $C(7),!!?5,"(No patient(s) selected for MAR run.)" K PSGPLF,PSGPLS
|
|---|
| 40 | DONE ;
|
|---|
| 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 | ;
|
|---|
| 53 | G ;
|
|---|
| 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 | ;
|
|---|
| 61 | W ;
|
|---|
| 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 | ;
|
|---|
| 67 | P ;
|
|---|
| 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 | ;
|
|---|
| 75 | C ;
|
|---|
| 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
|
|---|
| 80 | CDIC ;
|
|---|
| 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
|
|---|
| 84 | L ;
|
|---|
| 85 | K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
|
|---|
| 86 | S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
|
|---|
| 87 | LDIC ;
|
|---|
| 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
|
|---|
| 91 | DEV ;
|
|---|
| 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 | ;
|
|---|
| 98 | ENOR S PSGP=+ORVP
|
|---|
| 99 | ENLM ;
|
|---|
| 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
|
|---|
