- NURCEVE4 ;HIRMFO/RM,RTK-EDE LINK TO GMRG ;8/23/93
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1(DFN,GMRGPDA,GMRGRT,GMRGTERM) ; ENTRY TO SETUP ALL VARIABLES AND LINK TO GMRG SOFTWARE
- Q:'+GMRGTERM
- S GMRGOUT=0 L +^GMR(124.3,GMRGPDA,0):1 I '$T W !,$C(7),"ANOTHER TERMINAL IS EDITING THIS ENTRY!!" L -^GMR(124.3,GMRGPDA,0) Q
- K GMRGTPLT
- D DEM^VADPT,INP^VADPT S GMRGVNAM=VADM(1),GMRGVSSN=$P(VADM(2),U,2),GMRGVDOB=$P(VADM(3),U,2),GMRGVAGE=VADM(4),GMRGVAMV=VAIN(1),GMRGVPRV=$P(VAIN(2),U,2),GMRGVWRD=$P(VAIN(4),U,2),GMRGVRBD=VAIN(5),GMRGVADT=$P(VAIN(7),U,2),GMRGVDX=VAIN(9)
- K ^TMP($J) S GMRGTOP(0)=+GMRGRT,(GMRGNORD,GMRGUP)=0,(GMRGTOP,GMRGLVL,GMRGSLVL,GMRGTLVL)=1,GMRGLVL(1)=1,GMRGLVL(1,1)=1,GMRGTERM(0)=$S($D(^GMRD(124.2,+GMRGTERM,0)):^(0),1:""),GMRGSCRP=0
- S GMRGSITE=$S($P(GMRGTERM(0),"^",3)="":"",1:$O(^GMRD(124.1,1,1,"B",$P(GMRGTERM(0),"^",3),0))),GMRGSITE("P")=$S($D(^GMRD(124.1,1,1,+GMRGSITE,"P")):^("P"),1:""),GMRGSITE(0)=$S($D(^GMRD(124.1,1,1,+GMRGSITE,0)):^(0),1:"")
- S GMRGPRC=+GMRGTERM_"^^0",GMRGPRC(0)=$P(GMRGTERM,U,2)_U_$P(GMRGTERM,U,3)_U_$P($G(^GMR(124.3,GMRGPDA,1,+$P(GMRGTERM,U,3),0)),U,2)
- S ^TMP($J,"GMRGLVL",1,1,1)=GMRGPRC,^TMP($J,"GMRGLVL",1,1,1,0)=GMRGPRC(0),VAR=$O(^GMR(124.3,GMRGPDA,1,"B",+NURCX,0)),NURSPROB=1,NURSPROB(NURSPROB)=$P(NURCX,U,1,2)_"^"_VAR
- I $P(GMRGTERM,"^",3)="" S GMRGSTAT="^^"
- E S GMRGST=$P(GMRGTERM,"^",3),GMRGST(1)=GMRGPDA D STAT^GMRGRUT0
- I '$P(GMRGSTAT,"^",3) D ADSEL^GMRGEDB S $P(GMRGTERM,"^",3)=$P(GMRGPRC(0),"^",2)
- S IOP="HOME" D ^%ZIS S X="IORVON;IORVOFF" D ENDR^%ZISS S GMRGIO("RVOF")=IORVOFF,GMRGIO("RVON")=IORVON,GMRGIO("S")=$L(GMRGIO("RVOF"))&$L(GMRGIO("RVON")) K IORVOFF,IORVON
- S (GMRGLIN("-"),GMRGLIN("*"))="",$P(GMRGLIN("-"),"-",IOM+1)="",$P(GMRGLIN("*"),"*",IOM+1)=""
- F D EN1^GMRGED1 D QP^GMRGED2 S:'GMRGUP GMRGUP=GMRGNORD#2 I GMRGOUT!GMRGUP D Q3^GMRGED0 Q
- K GMRG,GMRGSCRP,GMRGSTAT,GMRGUP
- Q
- NURCEVE4 ;HIRMFO/RM,RTK-EDE LINK TO GMRG ;8/23/93
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- EN1(DFN,GMRGPDA,GMRGRT,GMRGTERM) ; ENTRY TO SETUP ALL VARIABLES AND LINK TO GMRG SOFTWARE
- +1 IF '+GMRGTERM
- QUIT
- +2 SET GMRGOUT=0
- LOCK +^GMR(124.3,GMRGPDA,0):1
- IF '$TEST
- WRITE !,$CHAR(7),"ANOTHER TERMINAL IS EDITING THIS ENTRY!!"
- LOCK -^GMR(124.3,GMRGPDA,0)
- QUIT
- +3 KILL GMRGTPLT
- +4 DO DEM^VADPT
- DO INP^VADPT
- SET GMRGVNAM=VADM(1)
- SET GMRGVSSN=$PIECE(VADM(2),U,2)
- SET GMRGVDOB=$PIECE(VADM(3),U,2)
- SET GMRGVAGE=VADM(4)
- SET GMRGVAMV=VAIN(1)
- SET GMRGVPRV=$PIECE(VAIN(2),U,2)
- SET GMRGVWRD=$PIECE(VAIN(4),U,2)
- SET GMRGVRBD=VAIN(5)
- SET GMRGVADT=$PIECE(VAIN(7),U,2)
- SET GMRGVDX=VAIN(9)
- +5 KILL ^TMP($JOB)
- SET GMRGTOP(0)=+GMRGRT
- SET (GMRGNORD,GMRGUP)=0
- SET (GMRGTOP,GMRGLVL,GMRGSLVL,GMRGTLVL)=1
- SET GMRGLVL(1)=1
- SET GMRGLVL(1,1)=1
- SET GMRGTERM(0)=$SELECT($DATA(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"")
- SET GMRGSCRP=0
- +6 SET GMRGSITE=$SELECT($PIECE(GMRGTERM(0),"^",3)="":"",1:$ORDER(^GMRD(124.1,1,1,"B",$PIECE(GMRGTERM(0),"^",3),0)))
- SET GMRGSITE("P")=$SELECT($DATA(^GMRD(124.1,1,1,+GMRGSITE,"P")):^("P"),1:"")
- SET GMRGSITE(0)=$SELECT($DATA(^GMRD(124.1,1,1,+GMRGSITE,0)):^(0),1:"")
- +7 SET GMRGPRC=+GMRGTERM_"^^0"
- SET GMRGPRC(0)=$PIECE(GMRGTERM,U,2)_U_$PIECE(GMRGTERM,U,3)_U_$PIECE($GET(^GMR(124.3,GMRGPDA,1,+$PIECE(GMRGTERM,U,3),0)),U,2)
- +8 SET ^TMP($JOB,"GMRGLVL",1,1,1)=GMRGPRC
- SET ^TMP($JOB,"GMRGLVL",1,1,1,0)=GMRGPRC(0)
- SET VAR=$ORDER(^GMR(124.3,GMRGPDA,1,"B",+NURCX,0))
- SET NURSPROB=1
- SET NURSPROB(NURSPROB)=$PIECE(NURCX,U,1,2)_"^"_VAR
- +9 IF $PIECE(GMRGTERM,"^",3)=""
- SET GMRGSTAT="^^"
- +10 IF '$TEST
- SET GMRGST=$PIECE(GMRGTERM,"^",3)
- SET GMRGST(1)=GMRGPDA
- DO STAT^GMRGRUT0
- +11 IF '$PIECE(GMRGSTAT,"^",3)
- DO ADSEL^GMRGEDB
- SET $PIECE(GMRGTERM,"^",3)=$PIECE(GMRGPRC(0),"^",2)
- +12 SET IOP="HOME"
- DO ^%ZIS
- SET X="IORVON;IORVOFF"
- DO ENDR^%ZISS
- SET GMRGIO("RVOF")=IORVOFF
- SET GMRGIO("RVON")=IORVON
- SET GMRGIO("S")=$LENGTH(GMRGIO("RVOF"))&$LENGTH(GMRGIO("RVON"))
- KILL IORVOFF,IORVON
- +13 SET (GMRGLIN("-"),GMRGLIN("*"))=""
- SET $PIECE(GMRGLIN("-"),"-",IOM+1)=""
- SET $PIECE(GMRGLIN("*"),"*",IOM+1)=""
- +14 FOR
- DO EN1^GMRGED1
- DO QP^GMRGED2
- IF 'GMRGUP
- SET GMRGUP=GMRGNORD#2
- IF GMRGOUT!GMRGUP
- DO Q3^GMRGED0
- QUIT
- +15 KILL GMRG,GMRGSCRP,GMRGSTAT,GMRGUP
- +16 QUIT