source: FOIAVistA/trunk/r/GEN_MED_REC_GENERATOR-GMRG/GMRGRUT2.m@ 1683

GMRGRUT2 ;CISC/RM,RTK-GMRG ROUTINE UTILITIES ;8/23/93
 ;;3.0;Text Generator;;Jan 24, 1996
EN1 ;TO PRINT/CALCULTE AGGY TEXT FOR A PATIENT (DFN) AND GMR TEXT ENTRY
 ; (GMRGPDA) INCLUDES THE INTERNAL AND APPENDED TEXT
 ;INPUT VARIABLES= 1.) GMRGXPRT= AGGY TEXT
 ;                 2.) GMRGXPRT(0)=PT DATA IN APPENDED/INTERNAL FIELD OF
 ;                                 SECTION SUBFIELD FOR AGGY TERM IN
 ;                                 GMRGXPRT.
 ;                 3.) GMRGXPRT(1)=RT MART^LENGTH^$S(1 IF INCLUDE
 ;                                 BRACKETS,O TO NOT INCLUDE BRACKETS)^
 ;                                 $S(1 TO HIGHLIGHT PRINT, 0 TO NOT)^
 ;                                 $S(0 TO PRINT THE TEXT OUT WITH THE
 ;                                    PREVIOUSLY SPECIFIED FORMAT,1 NOT
 ;                                    TO PRINT OUT THE DATA BUT TO PUT
 ;                                    IN THE VARIABLE GMRGXPRT)^
 ;                                  $S(1 TO HIDE TEXT IN <>, 0 NOT HIDE)
 ;                     optional variable defaut = 0^IOM^1^0^0
 ;
 ;OUTPUT IF $P(GMRGXPRT(1),"^",5)=0 THE AGGY TERM PRINTED OUT AND
 ;           THE VARIABLE GMRGXPRT IS KILLED
 ;       ELSE THE VARIABLE GMRGXPRT IS RETURNED AS THE PRINTABLE TEXT
 ;ALL VARIABLES KILLED
 Q:'$D(GMRGXPRT)!'$D(GMRGXPRT(0))  S:'$D(GMRGXPRT(1)) GMRGXPRT(1)="0^"_IOM_"^1^0"
 I $P(GMRGXPRT(1),"^",4),'$D(GMRGIO("RVON"))!'$D(GMRGIO("RVOF")) S X="IORVOFF;IORVON" D ENDR^%ZISS
 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
 I $P(GMRGXPRT(1),"^",6) D
 .   S GMRGXPRT(2)=GMRGXPRT
 .   F GMRGXPRT("X")=0:0 S GMRGXPRT("X")=$F(GMRGXPRT(2),"<",GMRGXPRT("X")) Q:GMRGXPRT("X")'>0  D REMOVE
 .   S GMRGXPRT=GMRGXPRT(2)
 .   Q
 I GMRGXPRT'["]" S GMRGXPRT(2)=GMRGXPRT
 E  D BRACK
 S GMRGXPRT(2)=GMRGXPRT(2)_$S($P(GMRGXPRT(0),"|")="":"",1:" "_$P(GMRGXPRT(0),"|"))
 S GMRGPLN=GMRGXPRT(2) F GMRGXPRT("X")=0:0 Q:$E(GMRGPLN,$L(GMRGPLN))'=" "  S GMRGPLN=$E(GMRGPLN,1,$L(GMRGPLN)-1)
 G:$P(GMRGXPRT(1),"^",5)=1 Q1 S GMRGLEN=$P(GMRGXPRT(1),"^",2)-$P(GMRGXPRT(1),"^") D FITLINE^GMRGRUT1
 W ?($P(GMRGXPRT(1),"^")) D HION W GMRGPLN(0) D HIOF
 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
Q1 I $P(GMRGXPRT(1),"^",5) K GMRGXPRT S GMRGXPRT=GMRGPLN
 E  K GMRGXPRT
 K GMRGPLN,DX,DY
 Q
REMOVE ;
 S GMRGXPRT("Y")=$F(GMRGXPRT(2),">",GMRGXPRT("X")) Q:GMRGXPRT("Y")'>0
 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
 Q
BRACK ;
 S GMRGXPRT(2)=$P(GMRGXPRT,"[")
 F GMRGXPRT(3)=1:1:($L(GMRGXPRT,"]")-1) D SBR
 Q
SBR ;
 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))
 S GMRGXPRT(2)=GMRGXPRT(2)_$S($P(GMRGXPRT(1),"^",3):"]",1:"")_$P($P(GMRGXPRT,"]",GMRGXPRT(3)+1),"[")
 Q
HION ;
 Q:'$P(GMRGXPRT(1),"^",4)  S DX=$X W GMRGXPRT(4) I DX'=$X S DY=$Y X ^%ZOSF("XY")
 Q
HIOF ;
 Q:'$P(GMRGXPRT(1),"^",4)  S DX=$X W GMRGXPRT(5) I DX'=$X S DY=$Y X ^%ZOSF("XY")
 Q
DEMPAT ; PRINT PATIENTS DEMOGRAPHIC DATA
 W !!,GMRGLIN("*"),!
 W "NAME: ",$E(GMRGVNAM,1,30),?39,"SSN: ",GMRGVSSN,?58,"DOB: ",GMRGVDOB
 I GMRGVAMV>0 W !,"ADMISSION DATE: ",GMRGVADT,?39,"WARD: ",GMRGVWRD
 W !,GMRGLIN("*"),!! R "Press return to continue ",X:DTIME I X="^"!(X="^^")!'$T S GMRGOUT=1 Q
 Q
PATDAT ; GIVEN GMRGPAT(X) AS "ALIST" ENTRIES FOR A PARTICULAR AGGY TERM
 ; AND GMRGND=TO AGGY TERM WHICH WE ARE LOOKING FOR IN "ALIST",
 ; AND GMRGPDA = THE ENTRY IN THE 124.3 FILE IN WHICH WE ARE LOOKING
 ; THIS FUNCTION RETURNS GMRGPRT=0 (NOT IN ARRAY),1 (IN ARRAY)
 ; AND GMRGPRT(0)=0TH NODE OF ENTRY IN 124.3, FILE
 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
 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
 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:"")
 K GMRGND,GMRG0
 Q