BTIUU.m

BTIUU ; IHS/ITSC/LJF - IHS UTILITY CALLS ;

 ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004

 ;

MSG(DATA,PRE,POST,BEEP) ;EP; -- writes line to device

 NEW I

 I PRE>0 F I=1:1:PRE W !

 W DATA

 I POST>0 F I=1:1:POST W !

 I $G(BEEP)>0 F I=1:1:BEEP W $C(7)

 Q

 ;

VALMSG() ;EP; -- sets help line message

 Q "- Previous Screen  Q Quit  ?? for More Actions"

 ;

INIT ;EP; -- initialize variables prior to printing report

 S TIUUSR=$$GET1^DIQ(200,DUZ,1)       ;user's initials

 S TIUFAC=$$GET1^DIQ(4,DUZ(2),.01)    ;facility name

 S TIUTIME=$$TIME($$NOW^XLFDT)        ;print time

 S TIUDATE=$$FMTE^XLFDT(DT)           ;print date

 Q

PRTKL ;EP; kill report header variables

 K TIUUSR,TIUFAC,TIUTIME,TIUDATE Q

 ;

CONFID(X) ;EP; return confidential message

 Q "*****Confidential Patient Data Covered by Privacy Act*****"

 ;

TIME(DATE) ;EP returns time in 12:00 PM format for date send

 Q $$UP^XLFSTR($E($$FMTE^XLFDT($E(DATE,1,12),"P"),14,21))

 ;

NUMDATE(D,YR) ;EP; returns external number date with leading zeros

 ; D=date and optionally time

 ; YR=1 for 2 digit year, =0 for 4 digit year

 NEW X

 I 'D Q ""

 I $G(YR) S X=$E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)

 E  S X=$E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))

 I $L(D)>7 S X=X_"@"_$$TIME(D)

 Q X

 ;

ZIS(X,TIURTN,TIUDESC,TIUVAR) ;EP; -- called to select device and send print

 K %ZIS,IOP

 S %ZIS=X D ^%ZIS Q:POP  I '$D(IO("Q")) D @TIURTN Q

 K IO("Q") S ZTRTN=TIURTN,ZTDESC=TIUDESC

 F I=1:1 S J=$P(TIUVAR,";",I) Q:J=""  S ZTSAVE(J)=""

 D ^%ZTLOAD K ZTSK D ^%ZISC

 Q

 ;

RETURN ;EP; -- ask user to press return with form feed

 NEW X,Y,DIR

 Q:IOST'["C-"

 K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR W @IOF

 K DIR Q

 ;

PAUSE ;EP; -- ask user to press return, no form feed

 NEW X,Y,DIR

 Q:IOST'["C-"

 K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR

 K DIR Q

 ;

 ; -- archive copies of PAD and SP subrtns

PAD(DATA,LENGTH) ; pad length of data

 Q $E(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 ;

SP(NUM) ; pad spaces

 Q $$PAD(" ",NUM)

BTIUU     ; IHS/ITSC/LJF - IHS UTILITY CALLS ;

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;;NOV 04, 2004

 +2       ;

MSG(DATA,PRE,POST,BEEP) ;EP; -- writes line to device

 +1        NEW I

 +2        IF PRE>0

               FOR I=1:1:PRE

                   WRITE !

 +3        WRITE DATA

 +4        IF POST>0

               FOR I=1:1:POST

                   WRITE !

 +5        IF $GET(BEEP)>0

               FOR I=1:1:BEEP

                   WRITE $CHAR(7)

 +6        QUIT 

 +7       ;

VALMSG()  ;EP; -- sets help line message

 +1        QUIT "- Previous Screen  Q Quit  ?? for More Actions"

 +2       ;

INIT      ;EP; -- initialize variables prior to printing report

 +1       ;user's initials

           SET TIUUSR=$$GET1^DIQ(200,DUZ,1)

 +2       ;facility name

           SET TIUFAC=$$GET1^DIQ(4,DUZ(2),.01)

 +3       ;print time

           SET TIUTIME=$$TIME($$NOW^XLFDT)

 +4       ;print date

           SET TIUDATE=$$FMTE^XLFDT(DT)

 +5        QUIT 

PRTKL     ;EP; kill report header variables

 +1        KILL TIUUSR,TIUFAC,TIUTIME,TIUDATE

           QUIT 

 +2       ;

CONFID(X) ;EP; return confidential message

 +1        QUIT "*****Confidential Patient Data Covered by Privacy Act*****"

 +2       ;

TIME(DATE) ;EP returns time in 12:00 PM format for date send

 +1        QUIT $$UP^XLFSTR($EXTRACT($$FMTE^XLFDT($EXTRACT(DATE,1,12),"P"),14,21))

 +2       ;

NUMDATE(D,YR) ;EP; returns external number date with leading zeros

 +1       ; D=date and optionally time

 +2       ; YR=1 for 2 digit year, =0 for 4 digit year

 +3        NEW X

 +4        IF 'D

               QUIT ""

 +5        IF $GET(YR)

               SET X=$EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)

 +6       IF '$TEST

               SET X=$EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_(1700+$EXTRACT(D,1,3))

 +7        IF $LENGTH(D)>7

               SET X=X_"@"_$$TIME(D)

 +8        QUIT X

 +9       ;

ZIS(X,TIURTN,TIUDESC,TIUVAR) ;EP; -- called to select device and send print

 +1        KILL %ZIS,IOP

 +2        SET %ZIS=X

           DO ^%ZIS

           IF POP

               QUIT 

           IF '$DATA(IO("Q"))

               DO @TIURTN

               QUIT 

 +3        KILL IO("Q")

           SET ZTRTN=TIURTN

           SET ZTDESC=TIUDESC

 +4        FOR I=1:1

               SET J=$PIECE(TIUVAR,";",I)

               IF J=""

                   QUIT 

               SET ZTSAVE(J)=""

 +5        DO ^%ZTLOAD

           KILL ZTSK

           DO ^%ZISC

 +6        QUIT 

 +7       ;

RETURN    ;EP; -- ask user to press return with form feed

 +1        NEW X,Y,DIR

 +2        IF IOST'["C-"

               QUIT 

 +3        KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press RETURN to continue"

           DO ^DIR

           WRITE @IOF

 +4        KILL DIR

           QUIT 

 +5       ;

PAUSE     ;EP; -- ask user to press return, no form feed

 +1        NEW X,Y,DIR

 +2        IF IOST'["C-"

               QUIT 

 +3        KILL DIR

           SET DIR(0)="E"

           SET DIR("A")="Press RETURN to continue"

           DO ^DIR

 +4        KILL DIR

           QUIT 

 +5       ;

 +6       ; -- archive copies of PAD and SP subrtns

PAD(DATA,LENGTH) ; pad length of data

 +1        QUIT $EXTRACT(DATA_$$REPEAT^XLFSTR(" ",LENGTH),1,LENGTH)

 +2       ;

SP(NUM)   ; pad spaces

 +1        QUIT $$PAD(" ",NUM)