source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJEEU.m@ 1739

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1PSJEEU ;BIR/CML3-EXTERNAL ENTRIES UTILITY ; 15 May 98 / 9:28 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**3**;16 DEC 97
3 ;
4ENSV ; schedule validation
5 ;K PSJAT,PSJM I $S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:'$D(^DIC(9.4,"C",PSJPP))) Q
6 ; changed to remove ref to 9.4,"C"
7 K PSJAT,PSJM Q:$S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:0) N DIC S X=PSJPP,DIC(0)="OX",DIC=9.4,D="C" D IX^DIC I +Y'>0 Q
8 Q:$D(PSJX)[0 I $D(PSJW),$S('PSJW:1,1:'$D(^SC(PSJW,0))) K PSJW
9 N D,DIC,DIE,Q,QX,SDW,SWD,X,X0,X1,X2,XT,Y,Z D EN^PSJSV Q
10 ;
11ENSVI ; standard schedule inquire
12 Q:$S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:0) S X=PSJPP,DIC(0)="OX",DIC=9.4,D="C" D IX^DIC I +Y'>0 Q
13 D ENI^PSJSV0
14 Q
15 ;
16ENSPU ; schedule processor (count)
17 K PSJC S PSJC=-1 I $S('$D(PSJAT):1,'$D(PSJM):1,'$D(PSJSCH):1,'$D(PSJSD):1,1:'$D(PSJFD)) Q
18 S:'$D(PSJOSD) PSJOSD=PSJSD S:'$D(PSJOFD) PSJOFD=PSJFD N AM,CD,H,HCD,I,J,M,MID,OD,PDL,PLSD,ST,Q,QQ,WD,WDT,WS,WS1,X,X1,X2,XX D EN^PSJSPU Q
19 ;
20ENPSJSE ; schedule edit for Inpatient Meds
21 S PSJPP="PSJ"
22 ;
23ENSE ; schedule edit
24 ;I $S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:'$D(^DIC(9.4,"C",PSJPP))) Q
25 ; changed to remove ref to 9.4,"C"
26 Q:$S('$D(PSJPP):1,PSJPP="":1,PSJPP?.E1C.E:1,1:0) S X=PSJPP,DIC(0)="OX",DIC=9.4,D="C" D IX^DIC I +Y'>0 Q
27 I $D(PSJW),$S('PSJW:1,1:'$D(^SC(PSJW,0))) K PSJW
28 F FQ=0:0 K DIC S DIC="^PS(51.1,",DIC(0)="QEASL",DIC("DR")="4////"_PSJPP,DIC("W")="D DICW^PSSJSV0",D="AP"_PSJPP W ! D IX^DIC K DIC Q:Y'>0 S DIE="^PS(51.1,",DA=+Y,DR="[PSSJ "_$S(PSJPP="PSJ":"",1:"EXT ")_"SCHEDULE EDIT]" D ^DIE K DA,DIE,DR,PSJS
29 K:PSJPP="PSJ" PSJPP K D0,DI,DISYS,DQ,FQ,X,Y
30 Q
31 ;
32ENDSD ; default start date
33 I $S('$D(PSJSCH):1,'$D(PSJAT):1,1:'$D(PSJTS)) S PSJX="" Q
34 D ENDSD^PSJSPU0 Q
35 ;
36ENPSJSHE ; shift edit for Inpatient Meds
37 S PSJPP="PSJ"
38 ;
39ENSHE ; shift edit
40 ;I $S('$D(PSJPP):1,PSJPP="":1,PSJPP'?.ANP:1,1:'$D(^DIC(9.4,"C",PSJPP))) Q
41 ; changed to remove ref to 9.4,"C"
42 Q:$S('$D(PSJPP):1,PSJPP="":1,PSJPP'?.ANP:1,1:0) S X=PSJPP,DIC(0)="OX",DIC=9.4,D="C" D IX^DIC I +Y'>0 Q
43 I $D(PSJW),$S('PSJW:1,1:'$D(^SC(PSJW,0))) K PSJW
44 F FQ=0:0 K DIC S DIC="^PS(51.15,",DIC(0)="AEQLS",DIC("DR")="4////"_PSJPP,D="AP"_PSJPP W ! D IX^DIC K DIC Q:Y'>0 S DIE="^PS(51.15,",DA=+Y,DR="[PSJ SHIFT EDIT]" D ^DIE K DA,DIE,DR
45 K FQ,X,Y Q
46 ;
47ENATV ; validate admin times
48 D ENCHK^PSJSV Q
49 ;
50ENSHV ;
51 D ENSHV^PSJSV Q
Note: See TracBrowser for help on using the repository browser.