| [613] | 1 | PSJMDWS ;BIR/MV-MAIN DRIVER FOR MED DUE WORKSHEET ;18 JUN 96 / 2:58 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**31,34,111**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | S PSJSTOP=0 K ^TMP($J)
|
|---|
| 6 | D ASK G:PSJSTOP EXIT
|
|---|
| 7 | EN I $D(IO("Q")) D G EXIT
|
|---|
| 8 | . NEW XDESC,XSAVE,XTRTN
|
|---|
| 9 | . S XDESC="Med Due Worksheet (SORT)"
|
|---|
| 10 | . S XSAVE="PSGIO;PSGMTYPE;PSGP;PSGP(;PSGPAT(;PSGPLF;PSGPLS;PSGRBADM;PSGSS;PSGTM;PSGTM(;PSGTMALL;PSGWD;PSGWG;PSGWGNM;PSGWN;PSJMPRN;PSGIODOC"
|
|---|
| 11 | . S XTRTN="SORTQ^PSJMDWS" D SETSORTQ^PSJMUTL(XDESC,XSAVE,XTRTN)
|
|---|
| 12 | D SORTQ
|
|---|
| 13 | Q
|
|---|
| 14 | SORTQ ;*** Entry when queue to do the sorting.
|
|---|
| 15 | NEW ADMIN,CD,DRG,DRGI,DRGN,DRGT,ON,MID,MN,ND,ND1,OD,PLSD,PSIVUP,PSJORIFN,PST,QST,RBNO,ST,T,TM,TMNO,TS,UD0,UD2,XTYPE
|
|---|
| 16 | D:PSGSS="G" ^PSJMEDS
|
|---|
| 17 | D:PSGSS="W" WARD^PSJMEDS
|
|---|
| 18 | I PSGSS="C" S PSGWG="^OTHER" D ^PSJMEDS
|
|---|
| 19 | I PSGSS="P" S PPN="" F S PPN=$O(PSGPAT(PPN)) Q:PPN="" S PSGP=PSGPAT(PPN) S PSJACNWP="" D ^PSJAC D MEDTYPE^PSJMEDS
|
|---|
| 20 | I $D(PSGIO) D G EXIT
|
|---|
| 21 | . NEW XDESC,XSAVE,XTRTN
|
|---|
| 22 | . S XDESC="Med Due Worksheet (PRINT)"
|
|---|
| 23 | . S XSAVE="PSGMTYPE;PSGP;PSGP(;PSGPAT(;PSGPLF;PSGPLS;PSGRBADM;PSGSS;PSGTM;PSGTM(;PSGTMALL;PSGWD;PSGWG;PSGWGNM;PSGWN;PSJMPRN;^TMP($J,;PSGIODOC"
|
|---|
| 24 | . S XTRTN="PRTQ^PSJMDWS" D SETPRTQ^PSJMUTL(XDESC,XSAVE,XTRTN)
|
|---|
| 25 | PRTQ ;*** Entry when queue to the printer.
|
|---|
| 26 | D ^PSJMPRT
|
|---|
| 27 | ;
|
|---|
| 28 | ;
|
|---|
| 29 | EXIT ;
|
|---|
| 30 | K ^TMP($J)
|
|---|
| 31 | D EXITDEV^PSJMUTL,EXIT^PSJMUTL
|
|---|
| 32 | D ENKV^PSGSETU ;*** Kill var called from ^PSJAC
|
|---|
| 33 | K PFLG,PPN,PSGEXPDT,PSGIO,PSGLFD,PSGLOD,PSGLSD,PSGMAR,PSGMARWD,PSGMFOR,PSGMTYPE,PSGOES,PSGON,PSGP,PSGPAT,PSGPG,PSGPLC,PSGPLF,PSGPLO
|
|---|
| 34 | K PSGPLS,PSGRBADM,PSGRBPPN,PSGRETF,PSGS0XT,PSGS0Y,PSGSS,PSGTM,PSGTMALL,PSGTMP,PSGTMP1,PSGWD,PSGWG,PSGWGNM
|
|---|
| 35 | K PSGWN,PSGWN1,PSJACNWP,PSJADT,PSJADT1,PSJADTO,PSJADTME,PSJATME1,PSJATMEO
|
|---|
| 36 | K PSJASTR,PSJATME,PSJATMEO,PSJDOS,PSJHL1,PSJHL2,PSJHL3,PSJHL62,PSJHOLD,PSJLN,PSJMPRN,PSJMR,PSJNEED,PSJONCAL,PSJONETM
|
|---|
| 37 | K PSJPLC,PSJPRB,PSJPRT,PSJPWDN,PSJPWDO,PSJSCHE,PSJSI,PSJSTOP,PSJTOTLN,ZSTOP,ZTQUEUED
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | ;
|
|---|
| 41 | ASK ;***Prompt for selection creteria. Quit when PSJSTOP=1
|
|---|
| 42 | ;
|
|---|
| 43 | Q:$$PRN^PSJMDIR S PSJMPRN=Y
|
|---|
| 44 | Q:$$STDATE^PSJMDIR S (X1,PSGTMP)=Y,X2=1 D C^%DTC S PSGTMP1=X,PSGPLS=Y
|
|---|
| 45 | Q:$$ENDATE^PSJMDIR(PSGTMP,PSGTMP1) S PSGPLF=Y
|
|---|
| 46 | Q:$$GWP^PSJMDIR1(1)
|
|---|
| 47 | Q:$$MEDTYPE^PSJMDIR($G(PSGWD)) S PSGMTYPE=Y
|
|---|
| 48 | Q:$$SELDEV^PSJMUTL
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | ENLM ;Enrty Point for PSJ LM MDWS protocol
|
|---|
| 52 | ;
|
|---|
| 53 | NEW VADM S PSJSTOP=0 K ^TMP($J)
|
|---|
| 54 | I '$D(PSGP(0)) S DFN=PSGP D DEM^VADPT S PSGP(0)=VADM(1) K VADM
|
|---|
| 55 | S PSGSS="P",PPN=PSGP(0),PSGPAT(PPN)=PSGP,PSJMDWS=1
|
|---|
| 56 | Q:$$PRN^PSJMDIR S PSJMPRN=Y
|
|---|
| 57 | Q:$$STDATE^PSJMDIR S (X1,PSGTMP)=Y,X2=1 D C^%DTC S PSGTMP1=X,PSGPLS=Y
|
|---|
| 58 | Q:$$ENDATE^PSJMDIR(PSGTMP,PSGTMP1) S PSGPLF=Y
|
|---|
| 59 | Q:$$MEDTYPE^PSJMDIR($G(PSGWD)) S PSGMTYPE=Y
|
|---|
| 60 | Q:$$SELDEV^PSJMUTL
|
|---|
| 61 | G EN
|
|---|
| 62 | ;
|
|---|
