QAMPBMW0 ;HISC/DAD-BUILD A MONITOR WORKSHEET ;4/26/93 13:36
;;1.0;Clinical Monitoring System;;09/13/1993
K DIR S DIR(0)="NAO^1:10:0"
S DIR("A")="How many worksheets do you want? ",DIR("B")=1
S DIR("?",1)="Enter the number of monitor worksheets you want printed."
S DIR("?")="You may request up to 10 worksheets."
W ! D ^DIR G:$D(DIRUT) EXIT S QAOSCOPY=Y
K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. K IO("Q")
. S ZTRTN="ENTSK^QAMPBMW0",ZTDTH=$H,ZTSAVE("QAOSCOPY")=""
. S ZTDESC="Build a monitor worksheet"
. D ^%ZTLOAD
.Q
ENTSK ;
U IO
F QAOSCPY=1:1:QAOSCOPY D ^QAMPBMW1 Q:QAOSQUIT W:QAOSCOPY-QAOSCPY @IOF
EXIT ;
W ! D ^%ZISC
K %ZIS,DIR,DIRUT,POP,QA,QAOSCOPY,QAOSCPY,QAOSD0,QAOSFILE,QAOSMID
K QAOSNUM,QAOSQUIT,QAOSTAB,QAOSTEXT,QAOSTOP,UNDL,X,Y,ZTDESC,ZTDTH
K ZTRTN,ZTSAVE
Q
;
EN(QAOSFILE) ; Print the contents of file QAOSFILE in 2 sorted columns
N QA,QAOSD0,QAOSQUIT,QAOSTAB,QAOSTEXT,QAOSTOP,X
S X=$$MIDDLE(QAOSFILE)
S QAOSTEXT(1)=0,QAOSTOP(1)=$P(X,"^")
S QAOSTEXT(2)=$P(X,"^",2),QAOSTOP(2)=""
S QAOSTAB=0 K QAOSD0
F Q:(QAOSTEXT(1)=QAOSTOP(1))&(QAOSTEXT(2)=QAOSTOP(2)) F QA=1,2 D
. I QAOSTEXT(QA)'=QAOSTOP(QA) S QAOSQUIT=0 F D Q:QAOSQUIT
.. I $G(QAOSD0(QA))="" S QAOSTEXT(QA)=$O(@(QAOSFILE_"""B"",QAOSTEXT(QA))"))
.. I QAOSTEXT(QA)=QAOSTOP(QA) S QAOSQUIT=1 Q
.. S QAOSD0(QA)=$O(@(QAOSFILE_"""B"",QAOSTEXT(QA),$G(QAOSD0(QA)))"))
.. Q:QAOSD0(QA)'>0
.. Q:$G(@(QAOSFILE_"""B"",QAOSTEXT(QA),+QAOSD0(QA))"))=1
.. S X=$P($G(@(QAOSFILE_"+QAOSD0(QA),0)")),"^") Q:X=""
.. W:'QAOSTAB ! W ?QAOSTAB,"___ ",$E(X,1,35)
.. S QAOSTAB=QAOSTAB+$S('QAOSTAB:40,1:-40),QAOSQUIT=1
.. Q
. Q
Q
;
MIDDLE(QAOSFILE) ; Return text of middle entry in B xref
N QAOSD0,QAOSMID,QAOSNUM,QAOSQUIT,QAOSTEXT
S QAOSNUM=$P(@(QAOSFILE_"0)"),"^",4)
S (QAOSTEXT,QAOSTEXT(0))="",(QAOSQUIT,QAOSMID)=0
I QAOSNUM>1 S QAOSNUM=QAOSNUM#2+QAOSNUM\2 D
. F S QAOSTEXT(0)=QAOSTEXT,QAOSTEXT=$O(@(QAOSFILE_"""B"",QAOSTEXT)")) Q:QAOSTEXT=""!QAOSQUIT D
.. F QAOSD0=0:0 S QAOSD0=$O(@(QAOSFILE_"""B"",QAOSTEXT,QAOSD0)")) Q:QAOSD0'>0 S QAOSMID=QAOSMID+1 I QAOSMID=QAOSNUM S QAOSQUIT=1 Q
.. Q
. Q
Q QAOSTEXT_"^"_QAOSTEXT(0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMPBMW0 2203 printed Nov 22, 2024@16:52:42 Page 2
QAMPBMW0 ;HISC/DAD-BUILD A MONITOR WORKSHEET ;4/26/93 13:36
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 KILL DIR
SET DIR(0)="NAO^1:10:0"
+3 SET DIR("A")="How many worksheets do you want? "
SET DIR("B")=1
+4 SET DIR("?",1)="Enter the number of monitor worksheets you want printed."
+5 SET DIR("?")="You may request up to 10 worksheets."
+6 WRITE !
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
SET QAOSCOPY=Y
+7 KILL %ZIS,IOP
SET %ZIS="QM"
WRITE !
DO ^%ZIS
if POP
GOTO EXIT
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 KILL IO("Q")
+10 SET ZTRTN="ENTSK^QAMPBMW0"
SET ZTDTH=$HOROLOG
SET ZTSAVE("QAOSCOPY")=""
+11 SET ZTDESC="Build a monitor worksheet"
+12 DO ^%ZTLOAD
+13 QUIT
End DoDot:1
GOTO EXIT
ENTSK ;
+1 USE IO
+2 FOR QAOSCPY=1:1:QAOSCOPY
DO ^QAMPBMW1
if QAOSQUIT
QUIT
if QAOSCOPY-QAOSCPY
WRITE @IOF
EXIT ;
+1 WRITE !
DO ^%ZISC
+2 KILL %ZIS,DIR,DIRUT,POP,QA,QAOSCOPY,QAOSCPY,QAOSD0,QAOSFILE,QAOSMID
+3 KILL QAOSNUM,QAOSQUIT,QAOSTAB,QAOSTEXT,QAOSTOP,UNDL,X,Y,ZTDESC,ZTDTH
+4 KILL ZTRTN,ZTSAVE
+5 QUIT
+6 ;
EN(QAOSFILE) ; Print the contents of file QAOSFILE in 2 sorted columns
+1 NEW QA,QAOSD0,QAOSQUIT,QAOSTAB,QAOSTEXT,QAOSTOP,X
+2 SET X=$$MIDDLE(QAOSFILE)
+3 SET QAOSTEXT(1)=0
SET QAOSTOP(1)=$PIECE(X,"^")
+4 SET QAOSTEXT(2)=$PIECE(X,"^",2)
SET QAOSTOP(2)=""
+5 SET QAOSTAB=0
KILL QAOSD0
+6 FOR
if (QAOSTEXT(1)=QAOSTOP(1))&(QAOSTEXT(2)=QAOSTOP(2))
QUIT
FOR QA=1,2
Begin DoDot:1
+7 IF QAOSTEXT(QA)'=QAOSTOP(QA)
SET QAOSQUIT=0
FOR
Begin DoDot:2
+8 IF $GET(QAOSD0(QA))=""
SET QAOSTEXT(QA)=$ORDER(@(QAOSFILE_"""B"",QAOSTEXT(QA))"))
+9 IF QAOSTEXT(QA)=QAOSTOP(QA)
SET QAOSQUIT=1
QUIT
+10 SET QAOSD0(QA)=$ORDER(@(QAOSFILE_"""B"",QAOSTEXT(QA),$G(QAOSD0(QA)))"))
+11 if QAOSD0(QA)'>0
QUIT
+12 if $GET(@(QAOSFILE_"""B"",QAOSTEXT(QA),+QAOSD0(QA))"))=1
QUIT
+13 SET X=$PIECE($GET(@(QAOSFILE_"+QAOSD0(QA),0)")),"^")
if X=""
QUIT
+14 if 'QAOSTAB
WRITE !
WRITE ?QAOSTAB,"___ ",$EXTRACT(X,1,35)
+15 SET QAOSTAB=QAOSTAB+$SELECT('QAOSTAB:40,1:-40)
SET QAOSQUIT=1
+16 QUIT
End DoDot:2
if QAOSQUIT
QUIT
+17 QUIT
End DoDot:1
+18 QUIT
+19 ;
MIDDLE(QAOSFILE) ; Return text of middle entry in B xref
+1 NEW QAOSD0,QAOSMID,QAOSNUM,QAOSQUIT,QAOSTEXT
+2 SET QAOSNUM=$PIECE(@(QAOSFILE_"0)"),"^",4)
+3 SET (QAOSTEXT,QAOSTEXT(0))=""
SET (QAOSQUIT,QAOSMID)=0
+4 IF QAOSNUM>1
SET QAOSNUM=QAOSNUM#2+QAOSNUM\2
Begin DoDot:1
+5 FOR
SET QAOSTEXT(0)=QAOSTEXT
SET QAOSTEXT=$ORDER(@(QAOSFILE_"""B"",QAOSTEXT)"))
if QAOSTEXT=""!QAOSQUIT
QUIT
Begin DoDot:2
+6 FOR QAOSD0=0:0
SET QAOSD0=$ORDER(@(QAOSFILE_"""B"",QAOSTEXT,QAOSD0)"))
if QAOSD0'>0
QUIT
SET QAOSMID=QAOSMID+1
IF QAOSMID=QAOSNUM
SET QAOSQUIT=1
QUIT
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
+9 QUIT QAOSTEXT_"^"_QAOSTEXT(0)
