source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXDIVIV.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1ECXDIVIV ;BIR/CML-Enter/Edit and Print IV Room Division ; 3/13/07 10:48am
2 ;;3.0;DSS EXTRACTS;**8,105**;Dec 22, 1997;Build 70
3 ;
4ED ;enter/edit division field for iv rooms
5 N CHKFLG,DIC,DIE,DA,DR
6 W !!,"This option allows editing of the DIVISION field for IV Rooms.",!
7 S CHKFLG=0,OUT=0
8 D CHK Q:CHKFLG
9 F D Q:OUT
10 .W ! S DIC=59.5,DIC(0)="QEAMZ" D ^DIC
11 .I Y<0 S OUT=1 Q
12 .I $G(^PS(59.5,+Y,"I"))]"" W " *INACTIVE*",$C(7)
13 .S DIE=DIC,DA=+Y
14 .S DR=.02 D ^DIE K DA
15 Q
16 ;
17PRT ;print worksheet
18 W !!,"This option will produce a worksheet listing all entries in the IV Room file"
19 W !,"(#59.5). It should be used to help DSS and Pharmacy services define and"
20 W !,"review the DIVISION assignments for each IV Room.",!! S QFLG=0
21 S QFLG=0,CHKFLG=0
22 D CHK Q:CHKFLG
23 D EN^XUTMDEVQ("START^ECXDIVIV","DSS - IV Room List")
24 I POP D
25 .W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
26 .D PAUSE
27 K ^TMP($J,"ECXDSS")
28 Q
29 ;
30START ;queued entry point
31 N CHKFLG,DIV,DIVNM,INACT,IV,IVRM,JJ,LN1,LN2,PDT,PG,QFLG,SS,X,Y
32 I '$D(DT) S DT=$$HTFM^XLFDT(+$H)
33 K ^TMP("ECXDIVIV",$J),^TMP($J,"ECXDSS") S QFLG=0,IV=0
34 ;call pharmacy encapsulation api and return all iv rooms information
35 D ALL^PSJ59P5(,"??","ECXDSS")
36 F S IV=$O(^TMP($J,"ECXDSS",IV)) Q:'IV D
37 .S IVRM=$G(^TMP($J,"ECXDSS",IV,.01)),DIV=$P($G(^(.02)),U)
38 .S DIVNM=$S(DIV="":"ZZZ",1:$E($P(^DG(40.8,DIV,0),U),1,30))
39 .K INACT I $P($G(^TMP($J,"ECXDSS",IV,19)),U)]"" S INACT=$P(^(19),U,2)
40 .S ^TMP("ECXDIVIV",$J,DIVNM,IVRM)=$S($D(INACT):INACT,1:"")
41 ;print report
42 S PG=0,PDT=$$FMTE^XLFDT(DT),$P(LN1,"-",81)="",$P(LN2,"_",30)=""
43 D HDR
44 I '$D(^TMP("ECXDIVIV",$J)) W !!,"No Data found for this worksheet."
45 I $D(^TMP("ECXDIVIV",$J)) S DIVNM="" D
46 .F S DIVNM=$O(^TMP("ECXDIVIV",$J,DIVNM)) Q:DIVNM="" Q:QFLG D
47 ..S IVRM=""
48 ..F S IVRM=$O(^TMP("ECXDIVIV",$J,DIVNM,IVRM)) Q:IVRM="" Q:QFLG D
49 ...S INACT=^TMP("ECXDIVIV",$J,DIVNM,IVRM)
50 ...D:$Y+4>IOSL HDR Q:QFLG
51 ...W !!,IVRM,?34,$S(DIVNM="ZZZ":LN2,1:DIVNM),?60,INACT
52 I $E(IOST)="C"&('QFLG) D PAUSE
53 K ^TMP("ECXDIVIV",$J) S:$D(ZTQUEUED) ZTREQ="@"
54 W:$E(IOST)'="C" @IOF
55 D ^%ZISC
56 Q
57 ;
58HDR ;header
59 I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
60 I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1
61 Q:QFLG
62 S PG=PG+1 W:$Y!($E(IOST)="C") @IOF
63 W !,"IV Room Worksheet",?72,"Page: ",PG,!,"Printed ",PDT
64 W !!,"IV ROOM",?34,"DIVISION",?60,"INACTIVE DATE",!,LN1
65 Q
66 ;
67CHK ;check for existence of necessary files for division functionality
68 S CHKFLG=0
69 D ALL^PSJ59P5(,"??","ECXIV")
70 I '$O(^TMP($J,"ECXIV",0)) D I CHKFLG D EXIT Q
71 .W !,"The IV Room file (#59.5) does not exist!"
72 .S CHKFLG=1 D PAUSE
73 I '$D(^ECX(728.113,0)) D I CHKFLG D EXIT Q
74 .W $C(7),!!,"Your facility appears to be running a version of Inpatient Medications prior to"
75 .W !,"version 4.5 which is necessary to use this option."
76 .S CHKFLG=1 D PAUSE
77 I '$D(^TMP($J,"ECXIV",$O(^TMP($J,"ECXIV",0)),.02)) D
78 .W $C(7),!!,"The Inpatient Medications Patch PSJ*4.5*27 has not yet been installed!"
79 .W !,"It must be loaded before you can proceed with this option."
80 .S CHKFLG=1 D PAUSE
81EXIT K ^TMP($J,"ECXIV")
82 Q
83 ;
84PAUSE ;pause screen
85 I $E(IOST)="C" D
86 .S SS=22-$Y F JJ=1:1:SS W !
87 .S DIR(0)="E" W ! D ^DIR K DIR
88 Q
Note: See TracBrowser for help on using the repository browser.