- GMRGED0 ;HIRMFO/RM,RTK-TEXT GENERATOR PATIENT DATA EDIT ;9/11/95
- ;;3.0;Text Generator;;Jan 24, 1996
- EN1 ; ENTRY TO GMR TEXT GENERATOR IF PRIME DOCUMENT IS KNOWN
- ; GMRGRT=PTR TO 124.2 FOR PD^PD TEXT
- Q:'$D(GMRGRT) Q:$P(GMRGRT,"^")'>0!($P(GMRGRT,"^",2)="")
- S (GMRGUP,GMRGOUT)=0,DIC="^DPT(",DIC(0)="AEQM",DIC("A")="Select Patient: " W ! D ^DIC K DIC S:$D(DTOUT)!$D(DUOUT) GMRGOUT=1 S:+Y'>0 GMRGUP=1 G Q1:GMRGOUT!GMRGUP S DFN=+Y
- D EN4 G Q1:GMRGOUT!GMRGUP,EN1
- Q1 K DFN,DIC,DTOUT,DUOUT,GMRGUP
- Q
- EN4 ; ENTRY IF PATIENT, PRIME DOCUMENT KNOWN
- Q:'$D(GMRGRT)!'$D(DFN)
- S GMRGXPRT="0^1^1" D EN1^GMRGRUT3 G:GMRGOUT!(GMRGPDA'>0) Q4
- D EN3 G Q4:GMRGOUT!GMRGUP,EN4
- Q4 S GMRGUP=0 K GMRGPDA
- Q
- EN3 ; ENTRY IF PATIENT, PRIME DOCUMENT AND GMR TEXT 124.3 FILE ENTRY KNOWN.
- ; DFN=PTR TO PATIENT, GMRGPDA=PTR TO 124.3 FILE, GMRGRT= PDOC PTR^TEXT
- Q:'$D(DFN)!'$D(GMRGPDA)!'$D(GMRGRT) Q:DFN'>0!(GMRGPDA'>0)!($P(GMRGRT,"^")'>0)!($P(GMRGRT,"^",2)="") K GMRGTPLT
- 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
- D BEGADD^GMRGED7
- 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) D KVAR^VADPT K VA
- K ^TMP($J) S GMRGTOP(0)=+GMRGRT,(GMRGNORD,GMRGUP)=0,(GMRGTOP,GMRGLVL)=1,GMRGLVL(1)=1,GMRGLVL(1,1)=1,GMRGTERM=GMRGRT,GMRGTERM(0)=$S($D(^GMRD(124.2,+GMRGRT,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=$P(GMRGRT,"^")_"^^0",GMRGPRC(0)=$P(GMRGRT,"^",2),^TMP($J,"GMRGLVL",1,1,1)=$P(GMRGRT,"^")_"^^0",^TMP($J,"GMRGLVL",1,1,1,0)=$P(GMRGRT,"^",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)="" ;D:$D(XRTL) T0^%ZOSV ; START RT
- D EN1^GMRGED1 D QP^GMRGED2 S:'GMRGUP GMRGUP=GMRGNORD#2
- I GMRGUP,'GMRGOUT D G Q3:GMRGOUT!GMRGUP,EN3
- . W ! S DIR("A")="Would you like to print a copy of this "_$P(GMRGRT,"^",2)_"? ",DIR(0)="YA",DIR("B")="YES" D ^DIR S:"^^"[Y GMRGOUT=1 Q:Y=0!GMRGOUT
- . D NOW^%DTC S GMRGPDT=%,GMRGPROU="D "_$S(GMRGSITE("P")'="":GMRGSITE("P"),1:"EN1^GMRGPUTL") X GMRGPROU
- . Q
- Q3 K ^TMP($J),D,DIK,GMRG0,GMRG00,GMRG01,GMRG02,GMRG03,GMRG1,GMRG2,GMRG10,GMRG11,GMRG12,GMRG13,GMRG14,GMRG3,GMRG4,GMRG5,GMRG6,GMRG7,GMRG8,GMRGART,GMRGCNT,GMRGDLT,GMRGDN,GMRGHOW,GMRGIO,GMRGJUMP
- K GMRGKU,GMRGL,GMRGLEN,GMRGLIN,GMRGLIST,GMRGLVL,GMRGOOD,GMRGMAX,GMRGMIN,GMRGMSR,GMRGND,GMRGNORD,GMRGPAT,GMRGPATH,GMRGPDT,GMRGPLN,GMRGPRC,GMRGPROU,GMRGPRT,GMRGPSEL,GMRGQ,GMRGQUSL,GMRGRDIS,GMRGREP
- K GMRGS,GMRGSCRP,GMRGSEL,GMRGSELC,GMRGSELP,GMRGSITE,GMRGSLVL,GMRGSLY,GMRGST,GMRGSTAR,GMRGTCHK,GMRGTDL,GMRGTERM,GMRGTLC,GMRGTLVL,GMRGTOP,GMRGTPLT,GMRGTX,GMRGUSL,GMRGXDF,GMRGY,Y,Z D KVAR^VADPT K VA L -^GMR(124.3,GMRGPDA,0)
- Q
- EN2 ; ENTRY TO GMR TEXT GENERATOR IF UNKNOWN PRIME DOCUMENT
- W !
- S DIC="^GMRD(124.2,",DIC(0)="AEQ",DIC("A")="Select Document for which patient data will be added: ",DIC("S")="S GMRG=$O(^GMRD(124.25,""B"",""PRIME DOCUMENT"",0)) I $P(^GMRD(124.2,+Y,0),U,4)=GMRG",DIC("W")="" D ^DIC K DIC G Q2:+Y'>0
- S GMRGRT=Y D EN1 G Q2:GMRGOUT,EN2
- Q2 K GMRGOUT,GMRGRT,DIC,GMRG
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGED0 3574 printed Mar 13, 2025@20:59:51 Page 2
- GMRGED0 ;HIRMFO/RM,RTK-TEXT GENERATOR PATIENT DATA EDIT ;9/11/95
- +1 ;;3.0;Text Generator;;Jan 24, 1996
- EN1 ; ENTRY TO GMR TEXT GENERATOR IF PRIME DOCUMENT IS KNOWN
- +1 ; GMRGRT=PTR TO 124.2 FOR PD^PD TEXT
- +2 if '$DATA(GMRGRT)
- QUIT
- if $PIECE(GMRGRT,"^")'>0!($PIECE(GMRGRT,"^",2)="")
- QUIT
- +3 SET (GMRGUP,GMRGOUT)=0
- SET DIC="^DPT("
- SET DIC(0)="AEQM"
- SET DIC("A")="Select Patient: "
- WRITE !
- DO ^DIC
- KILL DIC
- if $DATA(DTOUT)!$DATA(DUOUT)
- SET GMRGOUT=1
- if +Y'>0
- SET GMRGUP=1
- if GMRGOUT!GMRGUP
- GOTO Q1
- SET DFN=+Y
- +4 DO EN4
- if GMRGOUT!GMRGUP
- GOTO Q1
- GOTO EN1
- Q1 KILL DFN,DIC,DTOUT,DUOUT,GMRGUP
- +1 QUIT
- EN4 ; ENTRY IF PATIENT, PRIME DOCUMENT KNOWN
- +1 if '$DATA(GMRGRT)!'$DATA(DFN)
- QUIT
- +2 SET GMRGXPRT="0^1^1"
- DO EN1^GMRGRUT3
- if GMRGOUT!(GMRGPDA'>0)
- GOTO Q4
- +3 DO EN3
- if GMRGOUT!GMRGUP
- GOTO Q4
- GOTO EN4
- Q4 SET GMRGUP=0
- KILL GMRGPDA
- +1 QUIT
- EN3 ; ENTRY IF PATIENT, PRIME DOCUMENT AND GMR TEXT 124.3 FILE ENTRY KNOWN.
- +1 ; DFN=PTR TO PATIENT, GMRGPDA=PTR TO 124.3 FILE, GMRGRT= PDOC PTR^TEXT
- +2 if '$DATA(DFN)!'$DATA(GMRGPDA)!'$DATA(GMRGRT)
- QUIT
- if DFN'>0!(GMRGPDA'>0)!($PIECE(GMRGRT,"^")'>0)!($PIECE(GMRGRT,"^",2)="")
- QUIT
- KILL GMRGTPLT
- +3 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
- +4 DO BEGADD^GMRGED7
- +5 DO DEM^VADPT
- DO INP^VADPT
- +6 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)
- DO KVAR^VADPT
- KILL VA
- +7 KILL ^TMP($JOB)
- SET GMRGTOP(0)=+GMRGRT
- SET (GMRGNORD,GMRGUP)=0
- SET (GMRGTOP,GMRGLVL)=1
- SET GMRGLVL(1)=1
- SET GMRGLVL(1,1)=1
- SET GMRGTERM=GMRGRT
- SET GMRGTERM(0)=$SELECT($DATA(^GMRD(124.2,+GMRGRT,0)):^(0),1:"")
- SET GMRGSCRP=0
- +8 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:"")
- +9 SET GMRGPRC=$PIECE(GMRGRT,"^")_"^^0"
- SET GMRGPRC(0)=$PIECE(GMRGRT,"^",2)
- SET ^TMP($JOB,"GMRGLVL",1,1,1)=$PIECE(GMRGRT,"^")_"^^0"
- SET ^TMP($JOB,"GMRGLVL",1,1,1,0)=$PIECE(GMRGRT,"^",2)
- +10 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
- +11 ;D:$D(XRTL) T0^%ZOSV ; START RT
- SET (GMRGLIN("-"),GMRGLIN("*"))=""
- SET $PIECE(GMRGLIN("-"),"-",IOM+1)=""
- SET $PIECE(GMRGLIN("*"),"*",IOM+1)=""
- +12 DO EN1^GMRGED1
- DO QP^GMRGED2
- if 'GMRGUP
- SET GMRGUP=GMRGNORD#2
- +13 IF GMRGUP
- IF 'GMRGOUT
- Begin DoDot:1
- +14 WRITE !
- SET DIR("A")="Would you like to print a copy of this "_$PIECE(GMRGRT,"^",2)_"? "
- SET DIR(0)="YA"
- SET DIR("B")="YES"
- DO ^DIR
- if "^^"[Y
- SET GMRGOUT=1
- if Y=0!GMRGOUT
- QUIT
- +15 DO NOW^%DTC
- SET GMRGPDT=%
- SET GMRGPROU="D "_$SELECT(GMRGSITE("P")'="":GMRGSITE("P"),1:"EN1^GMRGPUTL")
- XECUTE GMRGPROU
- +16 QUIT
- End DoDot:1
- if GMRGOUT!GMRGUP
- GOTO Q3
- GOTO EN3
- Q3 KILL ^TMP($JOB),D,DIK,GMRG0,GMRG00,GMRG01,GMRG02,GMRG03,GMRG1,GMRG2,GMRG10,GMRG11,GMRG12,GMRG13,GMRG14,GMRG3,GMRG4,GMRG5,GMRG6,GMRG7,GMRG8,GMRGART,GMRGCNT,GMRGDLT,GMRGDN,GMRGHOW,GMRGIO,GMRGJUMP
- +1 KILL GMRGKU,GMRGL,GMRGLEN,GMRGLIN,GMRGLIST,GMRGLVL,GMRGOOD,GMRGMAX,GMRGMIN,GMRGMSR,GMRGND,GMRGNORD,GMRGPAT,GMRGPATH,GMRGPDT,GMRGPLN,GMRGPRC,GMRGPROU,GMRGPRT,GMRGPSEL,GMRGQ,GMRGQUSL,GMRGRDIS,GMRGREP
- +2 KILL GMRGS,GMRGSCRP,GMRGSEL,GMRGSELC,GMRGSELP,GMRGSITE,GMRGSLVL,GMRGSLY,GMRGST,GMRGSTAR,GMRGTCHK,GMRGTDL,GMRGTERM,GMRGTLC,GMRGTLVL,GMRGTOP,GMRGTPLT,GMRGTX,GMRGUSL,GMRGXDF,GMRGY,Y,Z
- DO KVAR^VADPT
- KILL VA
- LOCK -^GMR(124.3,GMRGPDA,0)
- +3 QUIT
- EN2 ; ENTRY TO GMR TEXT GENERATOR IF UNKNOWN PRIME DOCUMENT
- +1 WRITE !
- +2 SET DIC="^GMRD(124.2,"
- SET DIC(0)="AEQ"
- SET DIC("A")="Select Document for which patient data will be added: "
- SET DIC("S")="S GMRG=$O(^GMRD(124.25,""B"",""PRIME DOCUMENT"",0)) I $P(^GMRD(124.2,+Y,0),U,4)=GMRG"
- SET DIC("W")=""
- DO ^DIC
- KILL DIC
- if +Y'>0
- GOTO Q2
- +3 SET GMRGRT=Y
- DO EN1
- if GMRGOUT
- GOTO Q2
- GOTO EN2
- Q2 KILL GMRGOUT,GMRGRT,DIC,GMRG
- +1 QUIT
