Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRGRUT2

GMRGRUT2.m

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