source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJMDWS.m@ 1147

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

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1PSJMDWS ;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
7EN 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
14SORTQ ;*** 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)
25PRTQ ;*** Entry when queue to the printer.
26 D ^PSJMPRT
27 ;
28 ;
29EXIT ;
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 ;
41ASK ;***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 ;
51ENLM ;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 ;
Note: See TracBrowser for help on using the repository browser.