source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGCAP.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: 4.8 KB
Line 
1PSGCAP ;BIR/CML3-ACTION PROFILE (#2) ;04 APR 96 / 1:10 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**111**;16 DEC 97
3 N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
4 ;
5 D ENCV^PSGSETU I $D(XQUIT) Q
6 ;
7START ;
8 S (PSGAP,PSGP,PSGAPWD,PSGAPWG)=0,(PSGAPWDN,PSGAPWGN)="",PSGSSH="AP" S PSGPTMP=0,PPAGE=1
9 D ^PSGSEL G:PSGSS="^"!(PSGSS="") DONE D @PSGSS I (Y'="^OTHER"),(Y'>0) W !!?3,"No patient(s) selected. Option terminated." G START
10 ;
11ORS I '$G(PSGAPWG) S PSGAPS="P" G ORS1
12 S PSGAPS="T" I $S(PSGSS'="P":1,1:PSGPAT>1) F W !!,"Sort Action Profiles by (T)eam or Treating (P)rovider? T// " R PSGAPS:DTIME D Q1 Q:PSGAPS]""
13ORS1 G:PSGAPS="^" START D NOW^%DTC S PSGDT=% F N="START","STOP" D GDT G:$D(DIRUT) START
14 F W !!,"Print (A)ll active orders, or (E)xpiring orders only? A// " R PSGAPO:DTIME D Q2 Q:PSGAPO]""
15 G:PSGAPO="^" START
16 G:$$MEDTYPE^PSJMDIR($G(PSGWD)) START S PSGMTYPE=Y
17 K ZTSAVE F X="PSGAPS","PSGAPO","PSGAPSD","PSGAPFD","PSGMTYPE","PSGP","PSGSS","PSGAPWD","PSGAPWG","PSGAPWDN","PSGAPWGN","PSGPAT(","PSGPTMP","PPAGE" S ZTSAVE(X)=""
18 S PSGTIR="ENQ^PSGCAP0",ZTDESC="ACTION PROFILE" D ENDEV^PSGTI G:POP START G:$D(IO("Q")) DONE
19 W !,"...this may take a few minutes...(you really should QUEUE this report)..." D ENQ^PSGCAP0
20 ;
21 ;
22DONE ;
23 D ENKV^PSGSETU K CA,CNTR,DIAG,DO,DRG,FD,LQ,N,NF,ND,ND2,PSJJORD,PAGE,PDOB,PN,PND,PSEX,PSGAP,PSGAPWD,PSGAPWDN,PSGAPWG,PSGAPWGN,PSGDICA,PSGPAT,PSGSS
24 K PSGSSH,RB,RTE,SD,SI,SM,ST,STRT,STP,STT,WS,WT,S1,ZTOUT,PSGAPFD,PSGAPSD,PSGAPS,PSGAPO,PSJACNWP,PSJDLW,PSJOPC,PSJPWDO,PSGWD
25 K PSGADR,PSGALG,PSGEXPDT,PSGMTYPE,PSJSI,PSJSTOP,PSJTEAM,PST,QST
26 K ^TMP($J)
27 Q
28 ;
29GDT ;
30 K DIR NEW MINDT S:N="START" MINDT=PSGDT-.0001,DIR("B")="NOW" S:N="STOP" MINDT=PSGAPSD,DIR("B")=$$ENDD^PSGMI(PSGAPSD)
31 S DIR(0)="DA^"_MINDT_":9999999.9999:EFTX",DIR("?")="^D DTM^PSGCAP",DIR("A")="Enter "_$S(N["R":"START",1:"STOP")_" date/time: " D ^DIR K DIR Q:$D(DIRUT)
32 I X'="^" S:N["R" PSGAPSD=$S(Y'>0:PSGDT,Y#1:+$E(Y,1,12),1:Y+.0001) S:N["O" PSGAPFD=$S(Y'>0:9999999,Y#1:+$E(Y,1,12),1:Y+.24)
33 Q
34 ;
35G ; get ward group
36 S DIC="^PS(57.5,",DIC(0)="QEAMZ",DIC("A")="Select WARD GROUP: " W ! D ^DIC K DIC S:Y>0 PSGAPWG=+Y,PSGAPWGN=Y(0,0) I Y<0,X="^OTHER" D
37 . S (Y,PSGAPWG,PSGAPWGN)="^OTHER",(PSGAPWD,PSGAPWDN)="zz"
38 Q
39 ;
40C ;
41 K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
42 S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
43CDIC ;
44 K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y
45 W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
46 Q
47L ;
48 K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
49 S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
50LDIC ;
51 K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y
52 W:X["?" !!,"Enter the name of the clinic group you want to use to select patients for processing."
53 Q
54W ; get ward
55 S DIC="^DIC(42,",DIC(0)="QEAMZ",DIC("A")="Select WARD: " W ! D ^DIC K DIC S:Y>0 (PSGWD,PSGAPWD)=+Y,PSGAPWDN=Y(0,0) Q
56 ;
57P ; get patient
58 K PSGPAT,PSJPWDO,PSGWD
59 S PSGPAT=0 F CNTR=1:1 S:CNTR>1 PSGDICA="another" D ENP^PSGGAO Q:PSGP'>0 S PSGPAT(PSGP)="",PSGPAT=PSGPAT+1 S:'$G(PSJPWDO) (PSGWD,PSJPWDO)=PSJPWD S PSGWD=$S('$G(PSGWD):0,PSJPWDO=PSJPWD:PSJPWD,1:0)
60 S Y=$S(PSGPAT:1,1:-1) K PSGDICA Q
61 ;
62DTM ;
63 S Y=PSGDT D D^DIQ S T=$P(Y,"@",2),Y=$P(Y,",")
64 W !!?2,"Enter a ",N," date. If a time is not entered for the ",N," date, the",!,$S(N["R":"beginning",1:"end")," of the day is assumed and used."
65 W !?2,"If you wish to enter a ",$S(N["R":"start",1:"stop")," date of ",Y,", you must enter a TIME of day",!,"of ",T," or greater. Any date after ",Y," does not need time entered.",! S Y=-1 Q
66 ;
67Q1 ;
68 W:'$T $C(7) S:'$T PSGAPS="^" Q:PSGAPS="^"
69 I PSGAPS="" S PSGAPS="T" W " (TEAM)" Q
70 I PSGAPS?.E1C.E S PSGAPS="" W $C(7)," ??" Q
71 I PSGAPS?1."?" W !!?2,"Enter 'T' (or press RETURN) to sort and print patients by TEAM. Enter 'P'",!,"to sort and print patients by treating PROVIDER." S PSGAPS="" Q
72 F Q=1:1:$L(PSGAPS) I $E(PSGAPS,Q)?1L S PSGAPS=$E(PSGAPS,1,Q-1)_$C($A($E(PSGAPS,Q))-32)_$E(PSGAPS,Q+1,$L(PSGAPS))
73 F X="TEAM","PROVIDER" I $P(X,PSGAPS)="" W $P(X,PSGAPS,2) S PSGAPS=$E(X) Q
74 E W $C(7)," ??" S PSGAPS=""
75 Q
76 ;
77Q2 ;
78 W:'$T $C(7) S:'$T PSGAPO="^" Q:PSGAPO="^"
79 I PSGAPO="" S PSGAPO="A" W " (ALL)" Q
80 I PSGAPO?.E1C.E S PSGAPO="" W $C(7)," ??" Q
81 I PSGAPO?1."?" W !!?2,"Enter 'A' (or press RETURN) to print ALL ACTIVE orders for the patient(s)",!,"selected. Enter 'E' to print only orders that will EXPIRE within the date",!,"range selected for the patient(s) selected." S PSGAPO="" Q
82 F Q=1:1:$L(PSGAPO) I $E(PSGAPO,Q)?1L S PSGAPO=$E(PSGAPO,1,Q-1)_$C($A($E(PSGAPO,Q))-32)_$E(PSGAPO,Q+1,$L(PSGAPO))
83 F X="ALL","EXPIRING" I $P(X,PSGAPO)="" W $P(X,PSGAPO,2) S PSGAPO=$E(X) Q
84 E W $C(7)," ??" S PSGPAS=""
85 Q
86ENLM ;Entry point for PSJ LM AP2 protocol
87 N PSJNEW,PSGPTMP,PPAGE S PSJNEW=1
88 S PSGPTMP=0,PPAGE=1
89 D ENCV^PSGSETU I $D(XQUIT) Q
90 S PSGPAT=PSGP,PSGPAT(DFN)="",(PSGAPWD,PSGAPWG)=0,(PSGAPWDN,PSGAPWGN)="",PSGSS="P",PSGAPS="T" D ORS1
91 S PSJNKF=1 G DONE
Note: See TracBrowser for help on using the repository browser.