RMPRS ;PHX/HNC/RFM,RN,RVD,ATG/JPN-ADD SUSPENSE RECORD ;July 29, 2020@10:00
;;3.0;PROSTHETICS;**26,28,30,45,52,62,120,200**;Feb 09, 1996;Build 2
;
; HNC - patch 52 - 9/22/00 Modify INQ - sub.
; Add KILL^XUSCLEAN on exit to kill
; all variables.
; HNC - patch 52 - 10/5/00 New RMPR,RMPRNAM,RMPRDOB,RMPRSSN,RMPRSSNE
; RMPRCNUM before appt mgt
; RVD - patch 62 - 10/13/01 remove link to Patient Management
; call routine RMPREOL
; suspense print message
;
EN ;ADD SUSPENSE RECORD
; VSR (RN) patch RMPR*3.0*200 change four slashes to three slashes for validation before filing adding back tic to station
D DIV4^RMPRSIT G:$D(X) EXIT
S DIC="^DPT(",DIC(0)="AEQM" D ^DIC G:Y'>0 EXIT S RMPRDFN=+Y
S X=DT,DIC="^RMPR(668,",DIC(0)="AEQLM",DLAYGO=668,DIC("DR")="1////^S X=RMPRDFN;8////^S X=DUZ;2///^S X=""`""_RMPR(""STA"")" K DINUM,D0,DD,DO D FILE^DICN K DLAYGO G:Y'>0 EX S (RDA,DA)=+Y
S DIE="^RMPR(668,",DR="3;4"
L +^RMPR(668,RDA,0):1 I $T=0 W $C(7),?5,!,"Someone else is editing this record" G EX
D ^DIE L -^RMPR(668,RDA,0)
I '$P(^RMPR(668,RDA,0),U,3) S DA=RDA,DIK="^RMPR(668," D ^DIK W !,$C(7),?5,"Deleted..."
EX K X,DIC,DIE,DR,Y,RMPRDFN G EN
CL ;CLOSE OUT SUSPENSE RECORD
D DIV4^RMPRSIT G:$D(X) EXIT
K DIE,DR,Y,DA,RMPRA,^TMP("RMSU",$J)
S RMPRCLOS=1 D DICDPT S (I,RMTOI)=0 G:Y<0!($D(DTOUT))!(Y="^") EXIT
F S I=$O(^RMPR(668,"C",+Y,I)) Q:I'>0 I $D(^RMPR(668,I,0)) S:'$P(^(0),U,5) ^TMP("RMSU",$J,9999999-$P($G(^RMPR(668,I,0)),"^",1),I)=I,RMTOI=RMTOI+1
D ENT G:'IEN EXIT L +^RMPR(668,IEN,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" G EXIT
S RMPRA=IEN,DR="2;4;7",DA=IEN,DIE=DIC D ^DIE G:$D(Y) EX1
S DR="5//^S X=DT;6////^S X=DUZ",DA=RMPRA D ^DIE L -^RMPR(668,RMPRA,0)
EX1 I '$P(^RMPR(668,RMPRA,0),U,5) W !!,"SUSPENSE RECORD WAS NOT CLOSED OUT",$C(7) S $P(^(0),U,6)=""
W ! G CL
EXIT W:$D(FL1) @IOF K %,RMPRCLOS,DIC,DIE,DR,CITN,IEN,Y,DA,RDA,FL1,RB,RD,RT,RIE,RO,RP,RR,RZ,RX,RMPRFLAG,^TMP("RMSU",$J),RMI,RMIEN,RML,RMTOI,I,J,RMDES,RMQUIT,RMSEL Q
EN2 ;EDIT SUSPENSE RECORD
D DIV4^RMPRSIT G:$D(X) EXIT
D DICDPT G:Y<0!($D(DTOUT))!(Y="^") EXIT
;
;
REV ;reverse look-up.--HNC--change to $O(^RMPR(668,"C",ien,n),-1)
ENT ;sort/display
S (RMI,RML,RMTOI,RMQUIT,IEN,RMSEL,OUT)=0
W !,"CHOOSE FROM:"
S RMPRJ=""
F S RMPRJ=$O(^RMPR(668,"C",RMPRDFN,RMPRJ),-1) Q:RMPRJ="" Q:OUT=1 Q:IEN>0 D
.S RMTOI=RMTOI+1
.S RMI=RMI+1
.;S RML=RML+1
.S ^TMP("RMSU",$J,RMI)=RMPRDFN_U_RMPRJ
.I $Y>20 D DIS W @IOF Q
.D WRI
.Q:(RMQUIT)!(IEN)!(RMSEL)
G:RMSEL ENT
G:IEN PROC
I 'RMI W !!,"***** PATIENT HAS NO SUSPENSE RECORD!!!!" Q
;I RMQUIT W !!,"***** NO SELECTION MADE!!!" Q
D DIS
;W !!,"[<return> or '^' to Quit] or Choose Number 1-",RMI W ": " R X:DTIME I '$T Q
;I X=""!(X="^")!('$D(X)) W !!,"***** NO SELECTION MADE!!!" Q
;I '$D(^TMP("RMSU",$J,+X)) W !,$C(7),"****INVALID RESPONSE, Please choose a NUMBER within the range!!!!" G ENT
;S IEN=$P(^TMP("RMSU",$J,+X),U,2)
Q
;
PROC ;
L +^RMPR(668,IEN,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" Q
;
S Y=""
S RO=$G(^RMPR(668,+IEN,0)),Y=$P(^(0),U,1)
W " ",$$DAT1^RMPRUTL1(Y)
S DFN=RMPRDFN D DEM^VADPT
W " ",VADM(1)
W " ",$$STATUS^RMPREOU(+IEN)
S Y=+IEN
S DIC="^RMPR(668,"
Q:$D(RMPRFLAG)!$D(RMPRCLOS)!$D(FLAG)
S DIE=DIC,DA=Y,DR=".01;2R;1R;3;5;I $P(^RMPR(668,DA,0),U,5),'$P(^(0),U,6) S $P(^(0),U,6)=DUZ;4;7" D ^DIE I $D(DA),$P(^RMPR(668,DA,0),U,5)="" S $P(^(0),U,6)=""
L -^RMPR(668,IEN,0) G EN2
;
INQ ;Inquire to Suspense entry point
;
W @IOF
D DIV4^RMPRSIT G:$D(X) EXIT
D HOME^%ZIS
S RMPRFLAG=1
;get patient dfn
D DICDPT I Y'>0!($D(DTOUT))!(Y="^") K RMPRDFN G EXIT
S RMPRDFN=+Y
D REV I 'IEN K RMPRDFN G EXIT
;call new suspense processing
N RMPREOY,DA
S (RMPREOY,DA)=IEN D VIEWCP^RMPREO23
;clean up - patch 52
D KILL^XUSCLEAN
Q
;
EXT S RO=0 F S RO=$O(^RMPR(668,IEN,2,RO)) Q:RO'>0 W !,^RMPR(668,IEN,2,RO,0)
Q
;
ACT W !!,"ACTION TAKEN: "
I $D(^RMPR(668,IEN,3,0)) S RO=0 F S RO=$O(^RMPR(668,IEN,3,RO)) Q:RO'>0 W !,^RMPR(668,IEN,3,RO,0)
E W "NONE RECORDED"
W ! Q
LINK ;CLOSE OUT SUSPENSE ENTRY FOR SELECTED PATIENT
;call routine RMPREOL if PCE link to suspense, patch #62.
SUSP I $D(^TMP($J,"RMPRPCE",660)) D EN^RMPREOL,FULL^VALM1 Q
I '$D(^TMP($J,"RMPRPCE",660)) D EN^RMPREO
D FULL^VALM1
Q
;add new module HNC 3-2-00
N Y,RO,RR,RT,RX,RZ,J,RB,RIE,RD,RI,FLAG K ^TMP("RMSU",$J)
Q:'$D(RMPRDFN) Q:'$D(^RMPR(668,"C",RMPRDFN))
S RZ="S RX=$P(RO,U,3),RR=$S(RX=1:""PSC"",RX=2:""2421"",RX=3:""2237"",RX=4:""2529-3"",RX=5:""2529-7"",RX=6:""2474"",RX=7:""2431"",RX=8:""2914"",RX=9:""OTHER"",RX=10:""2520"",RX=11:""STOCK ISSUE"",1:""NONE"")"
S (RD,RI)=0 F S RD=$O(^RMPR(668,"C",RMPRDFN,RD)) Q:RD'>0 I $P(^RMPR(668,RD,0),U,5)="" S FLAG=1
Q:'$D(FLAG)
S %=1 W $C(7),!,"Suspense Records exist on this Patient. Do you wish to View/Edit them" D YN^DICN G:%=-1!(%=2)!($D(DTOUT)) EXIT I %=0 W !,"Answer `YES` or `NO`" G LINK
S Y=RMPRDFN,(I,RMTOI)=0 F S I=$O(^RMPR(668,"C",+Y,I)) Q:I'>0 I $D(^RMPR(668,I,0)) S:'$P(^(0),U,5) ^TMP("RMSU",$J,9999999-$P($G(^RMPR(668,I,0)),"^",1),I)=I,RMTOI=RMTOI+1
D ENT G:'IEN EXIT S DIE="^RMPR(668,",DA=IEN,DR="2R;5R;4;7" D ^DIE I $P(^RMPR(668,IEN,0),U,5) S $P(^(0),U,6)=DUZ
I $D(DTOUT)!($D(DUOUT)) G EXIT
G LINK
;
WRI ;write
;called from ENT, rmprdfn, rmprj defined
N RMPR668
S RO=$G(^RMPR(668,RMPRJ,0)),RMPR668=RMPRJ,Y=$P(^(0),U,1)
W !,RMI,".",?5,$$DAT1^RMPRUTL1(Y)
S DFN=$P(RO,U,2) D DEM^VADPT
W ?16,$E(VADM(1),1,19)
W ?37,$$STATUS^RMPREOU(RMPR668,9)
;display first part of description
I $D(^RMPR(668,RMPR668,2,1,0)) W ?48,$E(^RMPR(668,RMPR668,2,1,0),1,31)
Q
DIS ;continue
K DIR S DIR(0)="NO^1:"_RMI_":0" D ^DIR
I $D(DUOUT) S OUT=1 Q
I Y>0 S IEN=$P(^TMP("RMSU",$J,+Y),U,2)
Q
;
DICDPT ;ask patient from file #2
;
K DIC,^TMP("RMSU",$J)
S DIC="^DPT(",DIC(0)="AEQMZ"
S DIC("A")="Select PATIENT: " D ^DIC Q
;
;added in patch #62
SMESS ;print message for mandatory suspense entry.
;W !!,"*********************************************************"
;W !,"** No suspense record has been selected for this **"
;W !,"** transaction. You must POST INITIAL ACTION, POST **"
;W !,"** OTHER ACTION or POST COMPLETE suspense in order to **"
;W !,"** complete this transaction, otherwise transaction **"
;W !,"** will not be linked to SUSPENSE.................. **"
;W !,"*********************************************************"
;W !!
;K DIR
;S DIR(0)="SBO^L:LINK Suspense to Patient Record;E:EXIT without linking to Suspense"
;S DIR("A")="Would you like to LINK Suspense or EXIT without linking"
;S DIR("B")="L"
;S DIR("?")="Answer `L` to Link to suspense, 'E' to exit without link to suspense"
;D ^DIR S RMENTSUS=Y
;I $D(DIRUT)!$D(DUOUT)!$D(DTOUT) S RMENTSUS="E"
;W !! K DIR
;Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRS 6973 printed Oct 16, 2024@18:38:17 Page 2
RMPRS ;PHX/HNC/RFM,RN,RVD,ATG/JPN-ADD SUSPENSE RECORD ;July 29, 2020@10:00
+1 ;;3.0;PROSTHETICS;**26,28,30,45,52,62,120,200**;Feb 09, 1996;Build 2
+2 ;
+3 ; HNC - patch 52 - 9/22/00 Modify INQ - sub.
+4 ; Add KILL^XUSCLEAN on exit to kill
+5 ; all variables.
+6 ; HNC - patch 52 - 10/5/00 New RMPR,RMPRNAM,RMPRDOB,RMPRSSN,RMPRSSNE
+7 ; RMPRCNUM before appt mgt
+8 ; RVD - patch 62 - 10/13/01 remove link to Patient Management
+9 ; call routine RMPREOL
+10 ; suspense print message
+11 ;
EN ;ADD SUSPENSE RECORD
+1 ; VSR (RN) patch RMPR*3.0*200 change four slashes to three slashes for validation before filing adding back tic to station
+2 DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+3 SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
if Y'>0
GOTO EXIT
SET RMPRDFN=+Y
+4 SET X=DT
SET DIC="^RMPR(668,"
SET DIC(0)="AEQLM"
SET DLAYGO=668
SET DIC("DR")="1////^S X=RMPRDFN;8////^S X=DUZ;2///^S X=""`""_RMPR(""STA"")"
KILL DINUM,D0,DD,DO
DO FILE^DICN
KILL DLAYGO
if Y'>0
GOTO EX
SET (RDA,DA)=+Y
+5 SET DIE="^RMPR(668,"
SET DR="3;4"
+6 LOCK +^RMPR(668,RDA,0):1
IF $TEST=0
WRITE $CHAR(7),?5,!,"Someone else is editing this record"
GOTO EX
+7 DO ^DIE
LOCK -^RMPR(668,RDA,0)
+8 IF '$PIECE(^RMPR(668,RDA,0),U,3)
SET DA=RDA
SET DIK="^RMPR(668,"
DO ^DIK
WRITE !,$CHAR(7),?5,"Deleted..."
EX KILL X,DIC,DIE,DR,Y,RMPRDFN
GOTO EN
CL ;CLOSE OUT SUSPENSE RECORD
+1 DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+2 KILL DIE,DR,Y,DA,RMPRA,^TMP("RMSU",$JOB)
+3 SET RMPRCLOS=1
DO DICDPT
SET (I,RMTOI)=0
if Y<0!($DATA(DTOUT))!(Y="^")
GOTO EXIT
+4 FOR
SET I=$ORDER(^RMPR(668,"C",+Y,I))
if I'>0
QUIT
IF $DATA(^RMPR(668,I,0))
if '$PIECE(^(0),U,5)
SET ^TMP("RMSU",$JOB,9999999-$PIECE($GET(^RMPR(668,I,0)),"^",1),I)=I
SET RMTOI=RMTOI+1
+5 DO ENT
if 'IEN
GOTO EXIT
LOCK +^RMPR(668,IEN,0):1
IF $TEST=0
WRITE !,?5,$CHAR(7),"Someone else is Editing this entry!"
GOTO EXIT
+6 SET RMPRA=IEN
SET DR="2;4;7"
SET DA=IEN
SET DIE=DIC
DO ^DIE
if $DATA(Y)
GOTO EX1
+7 SET DR="5//^S X=DT;6////^S X=DUZ"
SET DA=RMPRA
DO ^DIE
LOCK -^RMPR(668,RMPRA,0)
EX1 IF '$PIECE(^RMPR(668,RMPRA,0),U,5)
WRITE !!,"SUSPENSE RECORD WAS NOT CLOSED OUT",$CHAR(7)
SET $PIECE(^(0),U,6)=""
+1 WRITE !
GOTO CL
EXIT if $DATA(FL1)
WRITE @IOF
KILL %,RMPRCLOS,DIC,DIE,DR,CITN,IEN,Y,DA,RDA,FL1,RB,RD,RT,RIE,RO,RP,RR,RZ,RX,RMPRFLAG,^TMP("RMSU",$JOB),RMI,RMIEN,RML,RMTOI,I,J,RMDES,RMQUIT,RMSEL
QUIT
EN2 ;EDIT SUSPENSE RECORD
+1 DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+2 DO DICDPT
if Y<0!($DATA(DTOUT))!(Y="^")
GOTO EXIT
+3 ;
+4 ;
REV ;reverse look-up.--HNC--change to $O(^RMPR(668,"C",ien,n),-1)
ENT ;sort/display
+1 SET (RMI,RML,RMTOI,RMQUIT,IEN,RMSEL,OUT)=0
+2 WRITE !,"CHOOSE FROM:"
+3 SET RMPRJ=""
+4 FOR
SET RMPRJ=$ORDER(^RMPR(668,"C",RMPRDFN,RMPRJ),-1)
if RMPRJ=""
QUIT
if OUT=1
QUIT
if IEN>0
QUIT
Begin DoDot:1
+5 SET RMTOI=RMTOI+1
+6 SET RMI=RMI+1
+7 ;S RML=RML+1
+8 SET ^TMP("RMSU",$JOB,RMI)=RMPRDFN_U_RMPRJ
+9 IF $Y>20
DO DIS
WRITE @IOF
QUIT
+10 DO WRI
+11 if (RMQUIT)!(IEN)!(RMSEL)
QUIT
End DoDot:1
+12 if RMSEL
GOTO ENT
+13 if IEN
GOTO PROC
+14 IF 'RMI
WRITE !!,"***** PATIENT HAS NO SUSPENSE RECORD!!!!"
QUIT
+15 ;I RMQUIT W !!,"***** NO SELECTION MADE!!!" Q
+16 DO DIS
+17 ;W !!,"[<return> or '^' to Quit] or Choose Number 1-",RMI W ": " R X:DTIME I '$T Q
+18 ;I X=""!(X="^")!('$D(X)) W !!,"***** NO SELECTION MADE!!!" Q
+19 ;I '$D(^TMP("RMSU",$J,+X)) W !,$C(7),"****INVALID RESPONSE, Please choose a NUMBER within the range!!!!" G ENT
+20 ;S IEN=$P(^TMP("RMSU",$J,+X),U,2)
+21 QUIT
+22 ;
PROC ;
+1 LOCK +^RMPR(668,IEN,0):1
IF $TEST=0
WRITE !,?5,$CHAR(7),"Someone else is Editing this entry!"
QUIT
+2 ;
+3 SET Y=""
+4 SET RO=$GET(^RMPR(668,+IEN,0))
SET Y=$PIECE(^(0),U,1)
+5 WRITE " ",$$DAT1^RMPRUTL1(Y)
+6 SET DFN=RMPRDFN
DO DEM^VADPT
+7 WRITE " ",VADM(1)
+8 WRITE " ",$$STATUS^RMPREOU(+IEN)
+9 SET Y=+IEN
+10 SET DIC="^RMPR(668,"
+11 if $DATA(RMPRFLAG)!$DATA(RMPRCLOS)!$DATA(FLAG)
QUIT
+12 SET DIE=DIC
SET DA=Y
SET DR=".01;2R;1R;3;5;I $P(^RMPR(668,DA,0),U,5),'$P(^(0),U,6) S $P(^(0),U,6)=DUZ;4;7"
DO ^DIE
IF $DATA(DA)
IF $PIECE(^RMPR(668,DA,0),U,5)=""
SET $PIECE(^(0),U,6)=""
+13 LOCK -^RMPR(668,IEN,0)
GOTO EN2
+14 ;
INQ ;Inquire to Suspense entry point
+1 ;
+2 WRITE @IOF
+3 DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+4 DO HOME^%ZIS
+5 SET RMPRFLAG=1
+6 ;get patient dfn
+7 DO DICDPT
IF Y'>0!($DATA(DTOUT))!(Y="^")
KILL RMPRDFN
GOTO EXIT
+8 SET RMPRDFN=+Y
+9 DO REV
IF 'IEN
KILL RMPRDFN
GOTO EXIT
+10 ;call new suspense processing
+11 NEW RMPREOY,DA
+12 SET (RMPREOY,DA)=IEN
DO VIEWCP^RMPREO23
+13 ;clean up - patch 52
+14 DO KILL^XUSCLEAN
+15 QUIT
+16 ;
EXT SET RO=0
FOR
SET RO=$ORDER(^RMPR(668,IEN,2,RO))
if RO'>0
QUIT
WRITE !,^RMPR(668,IEN,2,RO,0)
+1 QUIT
+2 ;
ACT WRITE !!,"ACTION TAKEN: "
+1 IF $DATA(^RMPR(668,IEN,3,0))
SET RO=0
FOR
SET RO=$ORDER(^RMPR(668,IEN,3,RO))
if RO'>0
QUIT
WRITE !,^RMPR(668,IEN,3,RO,0)
+2 IF '$TEST
WRITE "NONE RECORDED"
+3 WRITE !
QUIT
LINK ;CLOSE OUT SUSPENSE ENTRY FOR SELECTED PATIENT
+1 ;call routine RMPREOL if PCE link to suspense, patch #62.
SUSP IF $DATA(^TMP($JOB,"RMPRPCE",660))
DO EN^RMPREOL
DO FULL^VALM1
QUIT
+1 IF '$DATA(^TMP($JOB,"RMPRPCE",660))
DO EN^RMPREO
+2 DO FULL^VALM1
+3 QUIT
+4 ;add new module HNC 3-2-00
+5 NEW Y,RO,RR,RT,RX,RZ,J,RB,RIE,RD,RI,FLAG
KILL ^TMP("RMSU",$JOB)
+6 if '$DATA(RMPRDFN)
QUIT
if '$DATA(^RMPR(668,"C",RMPRDFN))
QUIT
+7 SET RZ="S RX=$P(RO,U,3),RR=$S(RX=1:""PSC"",RX=2:""2421"",RX=3:""2237"",RX=4:""2529-3"",RX=5:""2529-7"",RX=6:""2474"",RX=7:""2431"",RX=8:""2914"",RX=9:""OTHER"",RX=10:""2520"",RX=11:""STOCK ISSUE"",1:""NONE"")"
+8 SET (RD,RI)=0
FOR
SET RD=$ORDER(^RMPR(668,"C",RMPRDFN,RD))
if RD'>0
QUIT
IF $PIECE(^RMPR(668,RD,0),U,5)=""
SET FLAG=1
+9 if '$DATA(FLAG)
QUIT
+10 SET %=1
WRITE $CHAR(7),!,"Suspense Records exist on this Patient. Do you wish to View/Edit them"
DO YN^DICN
if %=-1!(%=2)!($DATA(DTOUT))
GOTO EXIT
IF %=0
WRITE !,"Answer `YES` or `NO`"
GOTO LINK
+11 SET Y=RMPRDFN
SET (I,RMTOI)=0
FOR
SET I=$ORDER(^RMPR(668,"C",+Y,I))
if I'>0
QUIT
IF $DATA(^RMPR(668,I,0))
if '$PIECE(^(0),U,5)
SET ^TMP("RMSU",$JOB,9999999-$PIECE($GET(^RMPR(668,I,0)),"^",1),I)=I
SET RMTOI=RMTOI+1
+12 DO ENT
if 'IEN
GOTO EXIT
SET DIE="^RMPR(668,"
SET DA=IEN
SET DR="2R;5R;4;7"
DO ^DIE
IF $PIECE(^RMPR(668,IEN,0),U,5)
SET $PIECE(^(0),U,6)=DUZ
+13 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+14 GOTO LINK
+15 ;
WRI ;write
+1 ;called from ENT, rmprdfn, rmprj defined
+2 NEW RMPR668
+3 SET RO=$GET(^RMPR(668,RMPRJ,0))
SET RMPR668=RMPRJ
SET Y=$PIECE(^(0),U,1)
+4 WRITE !,RMI,".",?5,$$DAT1^RMPRUTL1(Y)
+5 SET DFN=$PIECE(RO,U,2)
DO DEM^VADPT
+6 WRITE ?16,$EXTRACT(VADM(1),1,19)
+7 WRITE ?37,$$STATUS^RMPREOU(RMPR668,9)
+8 ;display first part of description
+9 IF $DATA(^RMPR(668,RMPR668,2,1,0))
WRITE ?48,$EXTRACT(^RMPR(668,RMPR668,2,1,0),1,31)
+10 QUIT
DIS ;continue
+1 KILL DIR
SET DIR(0)="NO^1:"_RMI_":0"
DO ^DIR
+2 IF $DATA(DUOUT)
SET OUT=1
QUIT
+3 IF Y>0
SET IEN=$PIECE(^TMP("RMSU",$JOB,+Y),U,2)
+4 QUIT
+5 ;
DICDPT ;ask patient from file #2
+1 ;
+2 KILL DIC,^TMP("RMSU",$JOB)
+3 SET DIC="^DPT("
SET DIC(0)="AEQMZ"
+4 SET DIC("A")="Select PATIENT: "
DO ^DIC
QUIT
+5 ;
+6 ;added in patch #62
SMESS ;print message for mandatory suspense entry.
+1 ;W !!,"*********************************************************"
+2 ;W !,"** No suspense record has been selected for this **"
+3 ;W !,"** transaction. You must POST INITIAL ACTION, POST **"
+4 ;W !,"** OTHER ACTION or POST COMPLETE suspense in order to **"
+5 ;W !,"** complete this transaction, otherwise transaction **"
+6 ;W !,"** will not be linked to SUSPENSE.................. **"
+7 ;W !,"*********************************************************"
+8 ;W !!
+9 ;K DIR
+10 ;S DIR(0)="SBO^L:LINK Suspense to Patient Record;E:EXIT without linking to Suspense"
+11 ;S DIR("A")="Would you like to LINK Suspense or EXIT without linking"
+12 ;S DIR("B")="L"
+13 ;S DIR("?")="Answer `L` to Link to suspense, 'E' to exit without link to suspense"
+14 ;D ^DIR S RMENTSUS=Y
+15 ;I $D(DIRUT)!$D(DUOUT)!$D(DTOUT) S RMENTSUS="E"
+16 ;W !! K DIR
+17 ;Q
