source: FOIAVistA/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMPBMW0.m@ 761

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1QAMPBMW0 ;HISC/DAD-BUILD A MONITOR WORKSHEET ;4/26/93 13:36
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3 K DIR S DIR(0)="NAO^1:10:0"
4 S DIR("A")="How many worksheets do you want? ",DIR("B")=1
5 S DIR("?",1)="Enter the number of monitor worksheets you want printed."
6 S DIR("?")="You may request up to 10 worksheets."
7 W ! D ^DIR G:$D(DIRUT) EXIT S QAOSCOPY=Y
8 K %ZIS,IOP S %ZIS="QM" W ! D ^%ZIS G:POP EXIT
9 I $D(IO("Q")) D G EXIT
10 . K IO("Q")
11 . S ZTRTN="ENTSK^QAMPBMW0",ZTDTH=$H,ZTSAVE("QAOSCOPY")=""
12 . S ZTDESC="Build a monitor worksheet"
13 . D ^%ZTLOAD
14 .Q
15ENTSK ;
16 U IO
17 F QAOSCPY=1:1:QAOSCOPY D ^QAMPBMW1 Q:QAOSQUIT W:QAOSCOPY-QAOSCPY @IOF
18EXIT ;
19 W ! D ^%ZISC
20 K %ZIS,DIR,DIRUT,POP,QA,QAOSCOPY,QAOSCPY,QAOSD0,QAOSFILE,QAOSMID
21 K QAOSNUM,QAOSQUIT,QAOSTAB,QAOSTEXT,QAOSTOP,UNDL,X,Y,ZTDESC,ZTDTH
22 K ZTRTN,ZTSAVE
23 Q
24 ;
25EN(QAOSFILE) ; Print the contents of file QAOSFILE in 2 sorted columns
26 N QA,QAOSD0,QAOSQUIT,QAOSTAB,QAOSTEXT,QAOSTOP,X
27 S X=$$MIDDLE(QAOSFILE)
28 S QAOSTEXT(1)=0,QAOSTOP(1)=$P(X,"^")
29 S QAOSTEXT(2)=$P(X,"^",2),QAOSTOP(2)=""
30 S QAOSTAB=0 K QAOSD0
31 F Q:(QAOSTEXT(1)=QAOSTOP(1))&(QAOSTEXT(2)=QAOSTOP(2)) F QA=1,2 D
32 . I QAOSTEXT(QA)'=QAOSTOP(QA) S QAOSQUIT=0 F D Q:QAOSQUIT
33 .. I $G(QAOSD0(QA))="" S QAOSTEXT(QA)=$O(@(QAOSFILE_"""B"",QAOSTEXT(QA))"))
34 .. I QAOSTEXT(QA)=QAOSTOP(QA) S QAOSQUIT=1 Q
35 .. S QAOSD0(QA)=$O(@(QAOSFILE_"""B"",QAOSTEXT(QA),$G(QAOSD0(QA)))"))
36 .. Q:QAOSD0(QA)'>0
37 .. Q:$G(@(QAOSFILE_"""B"",QAOSTEXT(QA),+QAOSD0(QA))"))=1
38 .. S X=$P($G(@(QAOSFILE_"+QAOSD0(QA),0)")),"^") Q:X=""
39 .. W:'QAOSTAB ! W ?QAOSTAB,"___ ",$E(X,1,35)
40 .. S QAOSTAB=QAOSTAB+$S('QAOSTAB:40,1:-40),QAOSQUIT=1
41 .. Q
42 . Q
43 Q
44 ;
45MIDDLE(QAOSFILE) ; Return text of middle entry in B xref
46 N QAOSD0,QAOSMID,QAOSNUM,QAOSQUIT,QAOSTEXT
47 S QAOSNUM=$P(@(QAOSFILE_"0)"),"^",4)
48 S (QAOSTEXT,QAOSTEXT(0))="",(QAOSQUIT,QAOSMID)=0
49 I QAOSNUM>1 S QAOSNUM=QAOSNUM#2+QAOSNUM\2 D
50 . F S QAOSTEXT(0)=QAOSTEXT,QAOSTEXT=$O(@(QAOSFILE_"""B"",QAOSTEXT)")) Q:QAOSTEXT=""!QAOSQUIT D
51 .. 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
52 .. Q
53 . Q
54 Q QAOSTEXT_"^"_QAOSTEXT(0)
Note: See TracBrowser for help on using the repository browser.