source: WorldVistAEHR/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGRUT2.m@ 623

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1GMRGRUT2 ;CISC/RM,RTK-GMRG ROUTINE UTILITIES ;8/23/93
2 ;;3.0;Text Generator;;Jan 24, 1996
3EN1 ;TO PRINT/CALCULTE AGGY TEXT FOR A PATIENT (DFN) AND GMR TEXT ENTRY
4 ; (GMRGPDA) INCLUDES THE INTERNAL AND APPENDED TEXT
5 ;INPUT VARIABLES= 1.) GMRGXPRT= AGGY TEXT
6 ; 2.) GMRGXPRT(0)=PT DATA IN APPENDED/INTERNAL FIELD OF
7 ; SECTION SUBFIELD FOR AGGY TERM IN
8 ; GMRGXPRT.
9 ; 3.) GMRGXPRT(1)=RT MART^LENGTH^$S(1 IF INCLUDE
10 ; BRACKETS,O TO NOT INCLUDE BRACKETS)^
11 ; $S(1 TO HIGHLIGHT PRINT, 0 TO NOT)^
12 ; $S(0 TO PRINT THE TEXT OUT WITH THE
13 ; PREVIOUSLY SPECIFIED FORMAT,1 NOT
14 ; TO PRINT OUT THE DATA BUT TO PUT
15 ; IN THE VARIABLE GMRGXPRT)^
16 ; $S(1 TO HIDE TEXT IN <>, 0 NOT HIDE)
17 ; optional variable defaut = 0^IOM^1^0^0
18 ;
19 ;OUTPUT IF $P(GMRGXPRT(1),"^",5)=0 THE AGGY TERM PRINTED OUT AND
20 ; THE VARIABLE GMRGXPRT IS KILLED
21 ; ELSE THE VARIABLE GMRGXPRT IS RETURNED AS THE PRINTABLE TEXT
22 ;ALL VARIABLES KILLED
23 Q:'$D(GMRGXPRT)!'$D(GMRGXPRT(0)) S:'$D(GMRGXPRT(1)) GMRGXPRT(1)="0^"_IOM_"^1^0"
24 I $P(GMRGXPRT(1),"^",4),'$D(GMRGIO("RVON"))!'$D(GMRGIO("RVOF")) S X="IORVOFF;IORVON" D ENDR^%ZISS
25 I $P(GMRGXPRT(1),"^",4) S GMRGXPRT(4)=$S($D(GMRGIO("RVON")):GMRGIO("RVON"),1:IORVON),GMRGXPRT(5)=$S($D(GMRGIO("RVOF")):GMRGIO("RVOF"),1:IORVOFF) K IORVON,IORVOFF
26 I $P(GMRGXPRT(1),"^",6) D
27 . S GMRGXPRT(2)=GMRGXPRT
28 . F GMRGXPRT("X")=0:0 S GMRGXPRT("X")=$F(GMRGXPRT(2),"<",GMRGXPRT("X")) Q:GMRGXPRT("X")'>0 D REMOVE
29 . S GMRGXPRT=GMRGXPRT(2)
30 . Q
31 I GMRGXPRT'["]" S GMRGXPRT(2)=GMRGXPRT
32 E D BRACK
33 S GMRGXPRT(2)=GMRGXPRT(2)_$S($P(GMRGXPRT(0),"|")="":"",1:" "_$P(GMRGXPRT(0),"|"))
34 S GMRGPLN=GMRGXPRT(2) F GMRGXPRT("X")=0:0 Q:$E(GMRGPLN,$L(GMRGPLN))'=" " S GMRGPLN=$E(GMRGPLN,1,$L(GMRGPLN)-1)
35 G:$P(GMRGXPRT(1),"^",5)=1 Q1 S GMRGLEN=$P(GMRGXPRT(1),"^",2)-$P(GMRGXPRT(1),"^") D FITLINE^GMRGRUT1
36 W ?($P(GMRGXPRT(1),"^")) D HION W GMRGPLN(0) D HIOF
37 F GMRGXPRT(3)=1:1 Q:GMRGPLN(1)="" S GMRGPLN=GMRGPLN(1),GMRGLEN=$P(GMRGXPRT(1),"^",2)-$P(GMRGXPRT(1),"^") D FITLINE^GMRGRUT1 W !,?($P(GMRGXPRT(1),"^")) D HION W GMRGPLN(0) D HIOF
38Q1 I $P(GMRGXPRT(1),"^",5) K GMRGXPRT S GMRGXPRT=GMRGPLN
39 E K GMRGXPRT
40 K GMRGPLN,DX,DY
41 Q
42REMOVE ;
43 S GMRGXPRT("Y")=$F(GMRGXPRT(2),">",GMRGXPRT("X")) Q:GMRGXPRT("Y")'>0
44 S GMRGXPRT(2)=$E(GMRGXPRT(2),1,GMRGXPRT("X")-$S($E(GMRGXPRT(2),GMRGXPRT("X")-2)'=" ":2,1:3))_$E(GMRGXPRT(2),GMRGXPRT("Y"),$L(GMRGXPRT(2))),GMRGXPRT("X")=0
45 Q
46BRACK ;
47 S GMRGXPRT(2)=$P(GMRGXPRT,"[")
48 F GMRGXPRT(3)=1:1:($L(GMRGXPRT,"]")-1) D SBR
49 Q
50SBR ;
51 S GMRGXPRT(2)=GMRGXPRT(2)_$S($P(GMRGXPRT(1),"^",3):"[",1:"")_$S($P(GMRGXPRT(0),"|",GMRGXPRT(3)+1)="":$P($P(GMRGXPRT,"[",GMRGXPRT(3)+1),"]"),1:$P(GMRGXPRT(0),"|",GMRGXPRT(3)+1))
52 S GMRGXPRT(2)=GMRGXPRT(2)_$S($P(GMRGXPRT(1),"^",3):"]",1:"")_$P($P(GMRGXPRT,"]",GMRGXPRT(3)+1),"[")
53 Q
54HION ;
55 Q:'$P(GMRGXPRT(1),"^",4) S DX=$X W GMRGXPRT(4) I DX'=$X S DY=$Y X ^%ZOSF("XY")
56 Q
57HIOF ;
58 Q:'$P(GMRGXPRT(1),"^",4) S DX=$X W GMRGXPRT(5) I DX'=$X S DY=$Y X ^%ZOSF("XY")
59 Q
60DEMPAT ; PRINT PATIENTS DEMOGRAPHIC DATA
61 W !!,GMRGLIN("*"),!
62 W "NAME: ",$E(GMRGVNAM,1,30),?39,"SSN: ",GMRGVSSN,?58,"DOB: ",GMRGVDOB
63 I GMRGVAMV>0 W !,"ADMISSION DATE: ",GMRGVADT,?39,"WARD: ",GMRGVWRD
64 W !,GMRGLIN("*"),!! R "Press return to continue ",X:DTIME I X="^"!(X="^^")!'$T S GMRGOUT=1 Q
65 Q
66PATDAT ; GIVEN GMRGPAT(X) AS "ALIST" ENTRIES FOR A PARTICULAR AGGY TERM
67 ; AND GMRGND=TO AGGY TERM WHICH WE ARE LOOKING FOR IN "ALIST",
68 ; AND GMRGPDA = THE ENTRY IN THE 124.3 FILE IN WHICH WE ARE LOOKING
69 ; THIS FUNCTION RETURNS GMRGPRT=0 (NOT IN ARRAY),1 (IN ARRAY)
70 ; AND GMRGPRT(0)=0TH NODE OF ENTRY IN 124.3, FILE
71 K GMRGPRT S GMRGPRT=0,GMRGPRT(0)="" F GMRG11=0:0 S GMRG11=$O(GMRGPAT(GMRG11)) Q:GMRG11'>0 I GMRGPAT(GMRG11)[("^"_GMRGND_"^") S GMRGPRT=1 Q
72 I 'GMRGPRT,$D(^GMR(124.3,GMRGPDA,1,"ALIST",GMRGND)) S GMRG0=GMRGND,GMRGND(0)=GMRGND,GMRGND(1)=$P(GMRGTERM,"^"),GMRGND=GMRGPDA D PARST^GMRGRUT0 S GMRGND=GMRG0,GMRGPRT=1
73 I GMRGPRT S GMRGND(0)=$O(^GMR(124.3,GMRGPDA,1,"B",GMRGND,0)) I GMRGND(0)>0 S GMRGPRT(0)=GMRGND(0)_"^"_$S($D(^GMR(124.3,GMRGPDA,1,GMRGND(0),0)):$P(^(0),"^",2),1:"")
74 K GMRGND,GMRG0
75 Q
Note: See TracBrowser for help on using the repository browser.