- ECXDIVIV ;BIR/CML-Enter/Edit and Print IV Room Division ;2/7/14 16:32
- ;;3.0;DSS EXTRACTS;**8,105,149**;Dec 22, 1997;Build 27
- ;
- ED ;enter/edit division field for iv rooms
- N CHKFLG,DIC,DIE,DA,DR
- W !!,"This option allows editing of the DIVISION field for IV Rooms.",!
- S CHKFLG=0,OUT=0
- D CHK Q:CHKFLG
- F D Q:OUT
- .W ! S DIC=59.5,DIC(0)="QEAMZ" D ^DIC
- .I Y<0 S OUT=1 Q
- .I $G(^PS(59.5,+Y,"I"))]"" W " *INACTIVE*",$C(7)
- .S DIE=DIC,DA=+Y
- .S DR=.02 D ^DIE K DA
- Q
- ;
- PRT ;print worksheet
- N ECXPORT,CNT ;149
- W !!,"This option will produce a worksheet listing all entries in the IV Room file"
- W !,"(#59.5). It should be used to help DSS and Pharmacy services define and"
- W !,"review the DIVISION assignments for each IV Room.",!! S QFLG=0
- S QFLG=0,CHKFLG=0
- D CHK Q:CHKFLG
- S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I ECXPORT D Q ;Section added in 149
- .K ^TMP($J,"ECXPORT")
- .S ^TMP($J,"ECXPORT",0)="IV ROOM^DIVISION^INACTIVE DATE",CNT=1
- .D START
- .D EXPDISP^ECXUTL1
- D EN^XUTMDEVQ("START^ECXDIVIV","DSS - IV Room List")
- I POP D
- .W !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
- .D PAUSE
- K ^TMP($J,"ECXDSS")
- Q
- ;
- START ;queued entry point
- N CHKFLG,DIV,DIVNM,INACT,IV,IVRM,JJ,LN1,LN2,PDT,PG,QFLG,SS,X,Y
- I '$D(DT) S DT=$$HTFM^XLFDT(+$H)
- K ^TMP("ECXDIVIV",$J),^TMP($J,"ECXDSS") S QFLG=0,IV=0
- ;call pharmacy encapsulation api and return all iv rooms information
- D ALL^PSJ59P5(,"??","ECXDSS")
- F S IV=$O(^TMP($J,"ECXDSS",IV)) Q:'IV D
- .S IVRM=$G(^TMP($J,"ECXDSS",IV,.01)),DIV=$P($G(^(.02)),U)
- .S DIVNM=$S(DIV="":"ZZZ",1:$E($P(^DG(40.8,DIV,0),U),1,30))
- .K INACT I $P($G(^TMP($J,"ECXDSS",IV,19)),U)]"" S INACT=$P(^(19),U,2)
- .S ^TMP("ECXDIVIV",$J,DIVNM,IVRM)=$S($D(INACT):INACT,1:"")
- ;print report
- S PG=0,PDT=$$FMTE^XLFDT(DT),$P(LN1,"-",81)="",$P(LN2,"_",30)=""
- I '$G(ECXPORT) D HDR ;149
- I '$D(^TMP("ECXDIVIV",$J)) I '$G(ECXPORT) W !!,"No Data found for this worksheet."
- I $D(^TMP("ECXDIVIV",$J)) S DIVNM="" D
- .F S DIVNM=$O(^TMP("ECXDIVIV",$J,DIVNM)) Q:DIVNM="" Q:QFLG D
- ..S IVRM=""
- ..F S IVRM=$O(^TMP("ECXDIVIV",$J,DIVNM,IVRM)) Q:IVRM="" Q:QFLG D
- ...S INACT=^TMP("ECXDIVIV",$J,DIVNM,IVRM)
- ...I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=IVRM_"^"_DIVNM_"^"_INACT,CNT=CNT+1 Q ;149
- ...D:$Y+4>IOSL HDR Q:QFLG
- ...W !!,IVRM,?34,$S(DIVNM="ZZZ":LN2,1:DIVNM),?60,INACT
- I $G(ECXPORT) K ^TMP("ECXDIVIV",$J) Q ;149
- I $E(IOST)="C"&('QFLG) D PAUSE
- K ^TMP("ECXDIVIV",$J) S:$D(ZTQUEUED) ZTREQ="@"
- W:$E(IOST)'="C" @IOF
- D ^%ZISC
- Q
- ;
- HDR ;header
- I $E(IOST)="C" S SS=22-$Y F JJ=1:1:SS W !
- I $E(IOST)="C",PG>0 S DIR(0)="E" W ! D ^DIR K DIR I 'Y S QFLG=1
- Q:QFLG
- S PG=PG+1 W:$Y!($E(IOST)="C") @IOF
- W !,"IV Room Worksheet",?72,"Page: ",PG,!,"Printed ",PDT
- W !!,"IV ROOM",?34,"DIVISION",?60,"INACTIVE DATE",!,LN1
- Q
- ;
- CHK ;check for existence of necessary files for division functionality
- S CHKFLG=0
- D ALL^PSJ59P5(,"??","ECXIV")
- I '$O(^TMP($J,"ECXIV",0)) D I CHKFLG D EXIT Q
- .W !,"The IV Room file (#59.5) does not exist!"
- .S CHKFLG=1 D PAUSE
- I '$D(^ECX(728.113,0)) D I CHKFLG D EXIT Q
- .W $C(7),!!,"Your facility appears to be running a version of Inpatient Medications prior to"
- .W !,"version 4.5 which is necessary to use this option."
- .S CHKFLG=1 D PAUSE
- I '$D(^TMP($J,"ECXIV",$O(^TMP($J,"ECXIV",0)),.02)) D
- .W $C(7),!!,"The Inpatient Medications Patch PSJ*4.5*27 has not yet been installed!"
- .W !,"It must be loaded before you can proceed with this option."
- .S CHKFLG=1 D PAUSE
- EXIT K ^TMP($J,"ECXIV")
- Q
- ;
- PAUSE ;pause screen
- I $E(IOST)="C" D
- .S SS=22-$Y F JJ=1:1:SS W !
- .S DIR(0)="E" W ! D ^DIR K DIR
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXDIVIV 3645 printed Feb 18, 2025@23:18:48 Page 2
- ECXDIVIV ;BIR/CML-Enter/Edit and Print IV Room Division ;2/7/14 16:32
- +1 ;;3.0;DSS EXTRACTS;**8,105,149**;Dec 22, 1997;Build 27
- +2 ;
- ED ;enter/edit division field for iv rooms
- +1 NEW CHKFLG,DIC,DIE,DA,DR
- +2 WRITE !!,"This option allows editing of the DIVISION field for IV Rooms.",!
- +3 SET CHKFLG=0
- SET OUT=0
- +4 DO CHK
- if CHKFLG
- QUIT
- +5 FOR
- Begin DoDot:1
- +6 WRITE !
- SET DIC=59.5
- SET DIC(0)="QEAMZ"
- DO ^DIC
- +7 IF Y<0
- SET OUT=1
- QUIT
- +8 IF $GET(^PS(59.5,+Y,"I"))]""
- WRITE " *INACTIVE*",$CHAR(7)
- +9 SET DIE=DIC
- SET DA=+Y
- +10 SET DR=.02
- DO ^DIE
- KILL DA
- End DoDot:1
- if OUT
- QUIT
- +11 QUIT
- +12 ;
- PRT ;print worksheet
- +1 ;149
- NEW ECXPORT,CNT
- +2 WRITE !!,"This option will produce a worksheet listing all entries in the IV Room file"
- +3 WRITE !,"(#59.5). It should be used to help DSS and Pharmacy services define and"
- +4 WRITE !,"review the DIVISION assignments for each IV Room.",!!
- SET QFLG=0
- +5 SET QFLG=0
- SET CHKFLG=0
- +6 DO CHK
- if CHKFLG
- QUIT
- +7 ;Section added in 149
- SET ECXPORT=$$EXPORT^ECXUTL1
- if ECXPORT=-1
- QUIT
- IF ECXPORT
- Begin DoDot:1
- +8 KILL ^TMP($JOB,"ECXPORT")
- +9 SET ^TMP($JOB,"ECXPORT",0)="IV ROOM^DIVISION^INACTIVE DATE"
- SET CNT=1
- +10 DO START
- +11 DO EXPDISP^ECXUTL1
- End DoDot:1
- QUIT
- +12 DO EN^XUTMDEVQ("START^ECXDIVIV","DSS - IV Room List")
- +13 IF POP
- Begin DoDot:1
- +14 WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!!"
- +15 DO PAUSE
- End DoDot:1
- +16 KILL ^TMP($JOB,"ECXDSS")
- +17 QUIT
- +18 ;
- START ;queued entry point
- +1 NEW CHKFLG,DIV,DIVNM,INACT,IV,IVRM,JJ,LN1,LN2,PDT,PG,QFLG,SS,X,Y
- +2 IF '$DATA(DT)
- SET DT=$$HTFM^XLFDT(+$HOROLOG)
- +3 KILL ^TMP("ECXDIVIV",$JOB),^TMP($JOB,"ECXDSS")
- SET QFLG=0
- SET IV=0
- +4 ;call pharmacy encapsulation api and return all iv rooms information
- +5 DO ALL^PSJ59P5(,"??","ECXDSS")
- +6 FOR
- SET IV=$ORDER(^TMP($JOB,"ECXDSS",IV))
- if 'IV
- QUIT
- Begin DoDot:1
- +7 SET IVRM=$GET(^TMP($JOB,"ECXDSS",IV,.01))
- SET DIV=$PIECE($GET(^(.02)),U)
- +8 SET DIVNM=$SELECT(DIV="":"ZZZ",1:$EXTRACT($PIECE(^DG(40.8,DIV,0),U),1,30))
- +9 KILL INACT
- IF $PIECE($GET(^TMP($JOB,"ECXDSS",IV,19)),U)]""
- SET INACT=$PIECE(^(19),U,2)
- +10 SET ^TMP("ECXDIVIV",$JOB,DIVNM,IVRM)=$SELECT($DATA(INACT):INACT,1:"")
- End DoDot:1
- +11 ;print report
- +12 SET PG=0
- SET PDT=$$FMTE^XLFDT(DT)
- SET $PIECE(LN1,"-",81)=""
- SET $PIECE(LN2,"_",30)=""
- +13 ;149
- IF '$GET(ECXPORT)
- DO HDR
- +14 IF '$DATA(^TMP("ECXDIVIV",$JOB))
- IF '$GET(ECXPORT)
- WRITE !!,"No Data found for this worksheet."
- +15 IF $DATA(^TMP("ECXDIVIV",$JOB))
- SET DIVNM=""
- Begin DoDot:1
- +16 FOR
- SET DIVNM=$ORDER(^TMP("ECXDIVIV",$JOB,DIVNM))
- if DIVNM=""
- QUIT
- if QFLG
- QUIT
- Begin DoDot:2
- +17 SET IVRM=""
- +18 FOR
- SET IVRM=$ORDER(^TMP("ECXDIVIV",$JOB,DIVNM,IVRM))
- if IVRM=""
- QUIT
- if QFLG
- QUIT
- Begin DoDot:3
- +19 SET INACT=^TMP("ECXDIVIV",$JOB,DIVNM,IVRM)
- +20 ;149
- IF $GET(ECXPORT)
- SET ^TMP($JOB,"ECXPORT",CNT)=IVRM_"^"_DIVNM_"^"_INACT
- SET CNT=CNT+1
- QUIT
- +21 if $Y+4>IOSL
- DO HDR
- if QFLG
- QUIT
- +22 WRITE !!,IVRM,?34,$SELECT(DIVNM="ZZZ":LN2,1:DIVNM),?60,INACT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +23 ;149
- IF $GET(ECXPORT)
- KILL ^TMP("ECXDIVIV",$JOB)
- QUIT
- +24 IF $EXTRACT(IOST)="C"&('QFLG)
- DO PAUSE
- +25 KILL ^TMP("ECXDIVIV",$JOB)
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +26 if $EXTRACT(IOST)'="C"
- WRITE @IOF
- +27 DO ^%ZISC
- +28 QUIT
- +29 ;
- HDR ;header
- +1 IF $EXTRACT(IOST)="C"
- SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +2 IF $EXTRACT(IOST)="C"
- IF PG>0
- SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- IF 'Y
- SET QFLG=1
- +3 if QFLG
- QUIT
- +4 SET PG=PG+1
- if $Y!($EXTRACT(IOST)="C")
- WRITE @IOF
- +5 WRITE !,"IV Room Worksheet",?72,"Page: ",PG,!,"Printed ",PDT
- +6 WRITE !!,"IV ROOM",?34,"DIVISION",?60,"INACTIVE DATE",!,LN1
- +7 QUIT
- +8 ;
- CHK ;check for existence of necessary files for division functionality
- +1 SET CHKFLG=0
- +2 DO ALL^PSJ59P5(,"??","ECXIV")
- +3 IF '$ORDER(^TMP($JOB,"ECXIV",0))
- Begin DoDot:1
- +4 WRITE !,"The IV Room file (#59.5) does not exist!"
- +5 SET CHKFLG=1
- DO PAUSE
- End DoDot:1
- IF CHKFLG
- DO EXIT
- QUIT
- +6 IF '$DATA(^ECX(728.113,0))
- Begin DoDot:1
- +7 WRITE $CHAR(7),!!,"Your facility appears to be running a version of Inpatient Medications prior to"
- +8 WRITE !,"version 4.5 which is necessary to use this option."
- +9 SET CHKFLG=1
- DO PAUSE
- End DoDot:1
- IF CHKFLG
- DO EXIT
- QUIT
- +10 IF '$DATA(^TMP($JOB,"ECXIV",$ORDER(^TMP($JOB,"ECXIV",0)),.02))
- Begin DoDot:1
- +11 WRITE $CHAR(7),!!,"The Inpatient Medications Patch PSJ*4.5*27 has not yet been installed!"
- +12 WRITE !,"It must be loaded before you can proceed with this option."
- +13 SET CHKFLG=1
- DO PAUSE
- End DoDot:1
- EXIT KILL ^TMP($JOB,"ECXIV")
- +1 QUIT
- +2 ;
- PAUSE ;pause screen
- +1 IF $EXTRACT(IOST)="C"
- Begin DoDot:1
- +2 SET SS=22-$Y
- FOR JJ=1:1:SS
- WRITE !
- +3 SET DIR(0)="E"
- WRITE !
- DO ^DIR
- KILL DIR
- End DoDot:1
- +4 QUIT