PSJMDWS ;BIR/MV-MAIN DRIVER FOR MED DUE WORKSHEET  ;18 JUN 96 / 2:58 PM
 ;;5.0; INPATIENT MEDICATIONS ;**31,34,111**;16 DEC 97
 ;
 ;
 S PSJSTOP=0 K ^TMP($J)
 D ASK G:PSJSTOP EXIT
EN I $D(IO("Q")) D  G EXIT
 . NEW XDESC,XSAVE,XTRTN
 . S XDESC="Med Due Worksheet (SORT)"
 . S XSAVE="PSGIO;PSGMTYPE;PSGP;PSGP(;PSGPAT(;PSGPLF;PSGPLS;PSGRBADM;PSGSS;PSGTM;PSGTM(;PSGTMALL;PSGWD;PSGWG;PSGWGNM;PSGWN;PSJMPRN;PSGIODOC"
 . S XTRTN="SORTQ^PSJMDWS" D SETSORTQ^PSJMUTL(XDESC,XSAVE,XTRTN)
 D SORTQ
 Q
SORTQ ;*** Entry when queue to do the sorting.
 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
 D:PSGSS="G" ^PSJMEDS
 D:PSGSS="W" WARD^PSJMEDS
 I PSGSS="C" S PSGWG="^OTHER" D ^PSJMEDS
 I PSGSS="P" S PPN="" F  S PPN=$O(PSGPAT(PPN)) Q:PPN=""  S PSGP=PSGPAT(PPN) S PSJACNWP="" D ^PSJAC D MEDTYPE^PSJMEDS
 I $D(PSGIO) D  G EXIT
 . NEW XDESC,XSAVE,XTRTN
 . S XDESC="Med Due Worksheet (PRINT)"
 . S XSAVE="PSGMTYPE;PSGP;PSGP(;PSGPAT(;PSGPLF;PSGPLS;PSGRBADM;PSGSS;PSGTM;PSGTM(;PSGTMALL;PSGWD;PSGWG;PSGWGNM;PSGWN;PSJMPRN;^TMP($J,;PSGIODOC"
 . S XTRTN="PRTQ^PSJMDWS" D SETPRTQ^PSJMUTL(XDESC,XSAVE,XTRTN)
PRTQ ;*** Entry when queue to the printer.
 D ^PSJMPRT
 ;
 ;
EXIT ;
 K ^TMP($J)
 D EXITDEV^PSJMUTL,EXIT^PSJMUTL
 D ENKV^PSGSETU ;*** Kill var called from ^PSJAC
 K PFLG,PPN,PSGEXPDT,PSGIO,PSGLFD,PSGLOD,PSGLSD,PSGMAR,PSGMARWD,PSGMFOR,PSGMTYPE,PSGOES,PSGON,PSGP,PSGPAT,PSGPG,PSGPLC,PSGPLF,PSGPLO
 K PSGPLS,PSGRBADM,PSGRBPPN,PSGRETF,PSGS0XT,PSGS0Y,PSGSS,PSGTM,PSGTMALL,PSGTMP,PSGTMP1,PSGWD,PSGWG,PSGWGNM
 K PSGWN,PSGWN1,PSJACNWP,PSJADT,PSJADT1,PSJADTO,PSJADTME,PSJATME1,PSJATMEO
 K PSJASTR,PSJATME,PSJATMEO,PSJDOS,PSJHL1,PSJHL2,PSJHL3,PSJHL62,PSJHOLD,PSJLN,PSJMPRN,PSJMR,PSJNEED,PSJONCAL,PSJONETM
 K PSJPLC,PSJPRB,PSJPRT,PSJPWDN,PSJPWDO,PSJSCHE,PSJSI,PSJSTOP,PSJTOTLN,ZSTOP,ZTQUEUED
 Q
 ;
 ;
ASK ;***Prompt for selection creteria.  Quit when PSJSTOP=1
 ;
 Q:$$PRN^PSJMDIR  S PSJMPRN=Y
 Q:$$STDATE^PSJMDIR  S (X1,PSGTMP)=Y,X2=1 D C^%DTC S PSGTMP1=X,PSGPLS=Y
 Q:$$ENDATE^PSJMDIR(PSGTMP,PSGTMP1)  S PSGPLF=Y
 Q:$$GWP^PSJMDIR1(1)
 Q:$$MEDTYPE^PSJMDIR($G(PSGWD))  S PSGMTYPE=Y
 Q:$$SELDEV^PSJMUTL
 Q
 ;
ENLM ;Enrty Point for PSJ LM MDWS protocol
 ;
 NEW VADM S PSJSTOP=0 K ^TMP($J)
 I '$D(PSGP(0)) S DFN=PSGP D DEM^VADPT S PSGP(0)=VADM(1) K VADM
 S PSGSS="P",PPN=PSGP(0),PSGPAT(PPN)=PSGP,PSJMDWS=1
 Q:$$PRN^PSJMDIR  S PSJMPRN=Y
 Q:$$STDATE^PSJMDIR  S (X1,PSGTMP)=Y,X2=1 D C^%DTC S PSGTMP1=X,PSGPLS=Y
 Q:$$ENDATE^PSJMDIR(PSGTMP,PSGTMP1)  S PSGPLF=Y
 Q:$$MEDTYPE^PSJMDIR($G(PSGWD))  S PSGMTYPE=Y
 Q:$$SELDEV^PSJMUTL
 G EN
 ;