RMPREOS ;HINES-CIOFO/HNC,RN,ATG/JPN -Suspense Processing ;July 29, 2020@10:00
;;3.0;PROSTHETICS;**45,50,52,55,57,62,80,85,97,135,200,206**;Feb 09, 1996;Build 4
;
; HNC - patch 52 - 9/22/00 Modify EN2 not to check for RMPRFLAG
; RMPRCLOS, or FLAG.
;
; HNC - patch 55 - 3/12/01 allow other note without initial
;
; HNC - patch 57 - 5/8/01 close out note message
;
; RVD - patch 62 - 8/13/01 link suspense to 2319 records.
;
; HNC - patch 80 - 8/28/03 Type to allow Editing, CLOSE SUSPENSE NOT
; CLOSED Screen Service for Consult Tracking
; (per Jerry)
;
; TH - patch 85 - 2/20/04 Fix bug-overwrite Initial Action Date,
; Note, and DUZ problem.
;
; KAM - patch 85 - 3/16/04 Allow forwarding of a consult to a "Tracker
; Only" service
; KAM - patch 97 - 8/19/04 Stop canceling the original consult when
; canceling the clone (in file 123)
;
;Patch 80 -Read File 123.5 DBIA 3861
; RGB - patch 206- 9/09/20 Ensure user linking an order to a Suspense
; entry sees that another user has the Suspense
; entry locked. Also, modified all other protocols
; with similar lock check message handling.
;
EN ;Add Manual Suspense
;
; VSR (RN) patch RMPR*3.0*200 change four slashes to three slashes for validation before filing adding back tic to station
D NOW^%DTC S X=%
S DIC="^RMPR(668,",DIC(0)="AEQLM",DLAYGO=668
S DIC("DR")="1////^S X=RMPRDFN;22R;14////^S X=""O"";8////^S X=DUZ;9////^S X=5;3////^S X=9;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="13;4"
L +^RMPR(668,RDA,0):1 I $T=0 W " <Another user is editing this entry>" H 2 G EX ;RMPR*3*206
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
Q
;
EN2 ;edit MANUAL suspense record
;DA must be defined
;
I $P(^RMPR(668,DA,0),U,8)'>4 W !!!,"Can Not Edit This Suspense Record!",!! H 2 Q
PROC L +^RMPR(668,DA):1 I $T=0 W " <Another user is editing this entry>" H 2 Q ;RMPR*3*206
S RO=$G(^RMPR(668,DA,0)),Y=$P(^(0),U,1) X ^DD("DD")
W " ",Y," ",$E($P(^DPT($P(RO,U,2),0),U,1),1,20)
;
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"")"
X RZ
W " ",RR," ",$S($P(RO,U,5)?7N.N:"CLOSED",1:"OPEN")
S DIE="^RMPR(668,"
;Q:$D(RMPRFLAG)!$D(RMPRCLOS)!$D(FLAG)
S DR="2R;22R;3;13;4"
D ^DIE
L -^RMPR(668,DA)
Q
ENIA ;initial action note
;
I $D(^RMPR(668,DA,3)) W !!!,"Initial Action Note Already Posted!",!! H 2 Q
L +^RMPR(668,DA):1 I $T=0 W " <Another user is editing this entry>" H 2 Q ;RMPR*3*206
D NOW^%DTC S RMPREODT=%
;link suspense to 2319 record, patch #62
I $D(^TMP($J,"RMPRPCE",660)) S ^TMP($J,"RMPRPCE",668,DA)="" D SEL60^RMPRPCEL
S DIE="^RMPR(668,"
S DR="7"
D ^DIE
I $D(^RMPR(668,DA,3)) S DR="10////^S X=RMPREODT;16////^S X=DUZ;14///^S X=""P""" D ^DIE
L -^RMPR(668,DA)
;check for a note here
I '$D(^RMPR(668,DA,3)) Q
;consult ien
S GMRCO=$P(^RMPR(668,DA,0),U,15) Q:GMRCO=""
;note in array
S RMPRCMT=0,GMRCMT=1
F S RMPRCMT=$O(^RMPR(668,DA,3,RMPRCMT)) Q:RMPRCMT="" D
.S GMRCMT(RMPRCMT)=^RMPR(668,DA,3,RMPRCMT,0)
I $G(GMRCMT(1))="" S GMRCMT(1)="nothing noted"
;call api
D CMT^GMRCGUIB(GMRCO,.GMRCMT,DUZ,RMPREODT,DUZ)
K RMPREODT,GMRCO,RMGMRCO,GMRCMT,RMPRCMT
Q
FORW ;forward consult
I $P(^RMPR(668,DA,0),U,8)>4 W !!!,"Can Not Forward.",!! H 2 Q
I $D(^RMPR(668,DA,4,1,0)) W !!!,"Completion Note Already Posted!",!! H 2 Q
D NOW^%DTC S RMPREODT=%,GMRCAD=%
;lookup service to forward consult
;S DIC("S")="I '$P(^(0),U,2),'+$G(^GMR(123.5,+Y,""IFC""))" ;*85
S DIC("S")="I $$SCR^RMPREOS(+Y,DUZ)" ;*85
S DIC="^GMR(123.5,",DIC(0)="AEQ"
S DIC("A")="Select Service To Forward Consult: "
D ^DIC
I (+Y'>0)!($D(DTOUT))!$D(DUOUT) W !!,"Not Forwarded! No Service Selected ." H 2 K DIC Q
S GMRCSS=+Y
L +^RMPR(668,DA):1 I $T=0 W " <Another user is editing this entry>" H 2 ;RMPR*3*206
S DIE="^RMPR(668,"
;stuff Consult forward service
S DR="23////^S X=GMRCSS"
D ^DIE
Q:'$P($G(^RMPR(668,DA,8)),U,6)
S DR="12"
D ^DIE
I $D(^RMPR(668,DA,4,1,0)) S DR="5////^S X=RMPREODT;6////^S X=DUZ;14///^S X=""C""" D ^DIE
;must have a note
I '$D(^RMPR(668,DA,4,1,0)) W !!,"Must Have Note to Forward. Consult Not Forwarded." S $P(^RMPR(668,DA,8),U,6)="" H 2 Q
;
; set initial action note if null
;I '$P(^RMPR(668,DA,0),U,10) D
;
; Check if Initial Action Date is null
I $P(^RMPR(668,DA,0),U,9)="" D
.S DIE="^RMPR(668,"
.; Set Initial Action Note
.S DR="7///^S X=""See Completion Note, this was forwarded to another service."""
.D ^DIE
.; Set Initial Action Date and Initial Action By
.;S DR="10////^S X=RMPREODT;16////^S X=DUZ;24////^S X=DUZ" D ^DIE
.S DR="10////^S X=RMPREODT;16////^S X=DUZ" D ^DIE
;
; Set Forwarded By
S DR="24////^S X=DUZ" D ^DIE
;
L -^RMPR(668,DA)
K RMPREODT
S GMRCO=$P(^RMPR(668,DA,0),U,15)
Q:GMRCO=""
;note in array
S RMPRCOM=0
F S RMPRCOM=$O(^RMPR(668,DA,4,RMPRCOM)) Q:RMPRCOM="" D
.S GMRCOM(RMPRCOM)=^RMPR(668,DA,4,RMPRCOM,0)
I $G(GMRCOM)="" S GMRCOM="not noted"
S GMRCORNP=DUZ
S GMRCURGI=""
S GMRCATTN=""
S BDC=$$FR^GMRCGUIA(.GMRCO,.GMRCSS,.GMRCORNP,.GMRCATTN,.GMRCURGI,.GMRCOM,.GMRCAD)
I +BDC=1 W !!,"ERROR, DID NOT FORWARD!" H 2
W !!,"Consult Forwarded." H 2
K GMRCO,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,GMRCOM,GMRCAD
Q
CLNT ;post closed note
;
I $P(^RMPR(668,DA,0),U,10)="C" W !!!,"Completion Note Already Posted!",!! H 2 Q
L +^RMPR(668,DA):1 I $T=0 W " <Another user is editing this entry>" H 2 Q ;RMPR*3*206
D NOW^%DTC S RMPREODT=%,GMRCAD=%
;link suspense to 2319 record, patch #62
I $D(^TMP($J,"RMPRPCE",660)) S ^TMP($J,"RMPRPCE",668,DA)="" D SEL60^RMPRPCEL
S DIE="^RMPR(668,"
S DR="12"
D ^DIE
I '$D(^RMPR(668,DA,4)) Q
I $D(^RMPR(668,DA,4)) S DR="5////^S X=RMPREODT;6////^S X=DUZ;14///^S X=""C""" D ^DIE
;set initial action note if null
I '$P(^RMPR(668,DA,0),U,9) D
.S DIE="^RMPR(668,"
.S DR="7///^S X=""See Completion Note for Initial Action Taken."""
.D ^DIE
.S DR="10////^S X=RMPREODT;16////^S X=DUZ" D ^DIE
;added by #62. Once closed, update all 2319 record for initial and
;completion date
D ICDT^RMPRPCEL(DA)
;
L -^RMPR(668,DA)
K RMPREODT
S GMRCO=$P(^RMPR(668,DA,0),U,15)
Q:GMRCO=""
;note in array
S RMPRCOM=0
F S RMPRCOM=$O(^RMPR(668,DA,4,RMPRCOM)) Q:RMPRCOM="" D
.S GMRCOM(RMPRCOM)=^RMPR(668,DA,4,RMPRCOM,0)
I $G(GMRCOM)="" S GMRCOM="not noted"
S GMRCSF="U"
S GMRCA=10
S GMRCALF="N"
S GMRCATO=""
S (GMRCORNP,GMRCDUZ)=DUZ
S BDC=$$SFILE^GMRCGUIB(.GMRCO,.GMRCA,.GMRCSF,.GMRCORNP,.GMRCDUZ,.GMRCOM,.GMRCALF,.GMRCATO,.GMRCAD)
I +BDC=1 W !!,$P(BDC,U,2) H 2
K GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD
Q
OACT ;other notes - no initial needed 3/12/01
;stuff date/time in.01
;delete if no note
;I '$D(^RMPR(668,DA,3,1,0)) W !!!,"No Initial Action Taken... ",!! H 2 Q
;
L +^RMPR(668,DA):1 I $T=0 W " <Another user is editing this entry>" H 2 Q ;RMPR*3*206
;link suspense to 2319 record, patch #62
I $D(^TMP($J,"RMPRPCE",660)) S ^TMP($J,"RMPRPCE",668,DA)="" D SEL60^RMPRPCEL
S DA(1)=DA,RMPRDA1=DA
S DIC="^RMPR(668,"_DA(1)_",1,"
S DIC(0)="CQL"
S DIC("P")=$P(^DD(668,11,0),U,2)
D NOW^%DTC S X=%,GMRCWHN=%
S DLAYGO=688
D ^DIC
I Y=-1 K DIC,DA Q
S DIE=DIC K DIC
S (DA,RMPRDA2)=+Y
S DR="1" D ^DIE
K DIE,DR,Y
I '$D(^RMPR(668,RMPRDA1,1,RMPRDA2,1,0)) D Q
.;delete the record if no note
.S DIK="^RMPR(668,RMPRDA1,1,"
.S DA=RMPRDA2
.D ^DIK
.K DA,DIA,RMPRDA1,RMPRDA2,GMRCWHN
;send data to consults if note
S GMRCO=$P(^RMPR(668,RMPRDA1,0),U,15)
I GMRCO="" Q
;GMRCOM is comment array
S RMPRCOM=0
F S RMPRCOM=$O(^RMPR(668,RMPRDA1,1,RMPRDA2,1,RMPRCOM)) Q:RMPRCOM="" D
.S GMRCOM(RMPRCOM)=^RMPR(668,RMPRDA1,1,RMPRDA2,1,RMPRCOM,0)
;
L -^RMPR(668,RMPRDA1)
;GMRCWHN was set to date/time
D CMT^GMRCGUIB(.GMRCO,.GMRCOM,"",.GMRCWHN,DUZ)
;check ok
K DA,DIK,RMPRDA1,RMPRDA2,RMPRCOM,GMRCOM,GMRCO,GMRCWHN
Q
CANCEL ;cancel suspense
;set status to X and cancelled by to duz, date/time.
;start
;
I $P(^RMPR(668,DA,0),U,5)'="" W !!!,"This has already been completed, cannot cancel!",!! H 2 Q
L +^RMPR(668,DA):1 I $T=0 W " <Another user is editing this entry>" H 2 Q ;RMPR*3*206
K Y
S DIR(0)="Y",DIR("B")="N"
W !!!,"This will CANCEL/DELETE this Suspense Request."
S DIR("A")="Are you sure you want to CANCEL/DELETE this Suspense Request? (Y/N) "
D ^DIR I $D(DTOUT)!$D(DUOUT)!(Y="^")!(Y=0) W !!,"Suspense Not Cancelled!" H 2 Q
D NOW^%DTC S RMPREODT=%
S DIE="^RMPR(668,"
S DR="14///^S X=""X"";17////^S X=DUZ;18////^S X=RMPREODT;9"
D ^DIE
W !!,?5,"DELETED/CANCELLED!" H 2
L -^RMPR(668,DA)
;consult ien
S GMRCO=$P(^RMPR(668,DA,0),U,15) Q:GMRCO=""
;note in array
S RMPRCMT=0
F S RMPRCMT=$O(^RMPR(668,DA,9,RMPRCMT)) Q:RMPRCMT="" D
.S GMRCMT(RMPRCMT)=^RMPR(668,DA,9,RMPRCMT,0)
I $G(GMRCMT)="" S GMRCMT="nothing noted"
;call api
;DY for cancelled, deny
S GMRCACTM="DY"
; PATCH RMPR*3*97 if canceling a clone do not update file 123 7=clone
I $P(^RMPR(668,DA,0),U,8)'=7 D
. S RMGMRCO=$$DC^GMRCGUIA(.GMRCO,DUZ,RMPREODT,.GMRCACTM,.GMRCMT)
K RMPREODT,GMRCMT,RMPRCMT,GMRCACTM
Q
;
LINK60 ;link suspense to 2319 records
S RMSERR=0
F RMSI=0:0 S RMSI=$O(^TMP($J,"RMPRPCE",660,RMSI)) Q:RMSI'>0 D
.S RMSAMIS=$G(^TMP($J,"RMPRPCE",660,RMSI))
.;call update 668
.S RMSERR=$$UP68^RMPRPCE1(RMSI,DA,+RMSAMIS)
Q:RMSERR=1
S ^TMP($J,"RMPRPCE",668,DA)=""
Q
;end
SCR(SERV,USR) ; SCREEN SERVICES THAT CAN BE FORWARDED TO ,RMPR*3*85
N USAGE
S USAGE=$P(^GMR(123.5,SERV,0),U,2)
I USAGE=9!(USAGE=1) Q 0 ;disabled or grouper service
I USAGE=2 Q $$VALIDU^GMRCAU(SERV,USR) ;tracking and check update user
Q 1 ;service usage must be null = O
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPREOS 10270 printed Apr 09, 2024@21:37:36 Page 2
RMPREOS ;HINES-CIOFO/HNC,RN,ATG/JPN -Suspense Processing ;July 29, 2020@10:00
+1 ;;3.0;PROSTHETICS;**45,50,52,55,57,62,80,85,97,135,200,206**;Feb 09, 1996;Build 4
+2 ;
+3 ; HNC - patch 52 - 9/22/00 Modify EN2 not to check for RMPRFLAG
+4 ; RMPRCLOS, or FLAG.
+5 ;
+6 ; HNC - patch 55 - 3/12/01 allow other note without initial
+7 ;
+8 ; HNC - patch 57 - 5/8/01 close out note message
+9 ;
+10 ; RVD - patch 62 - 8/13/01 link suspense to 2319 records.
+11 ;
+12 ; HNC - patch 80 - 8/28/03 Type to allow Editing, CLOSE SUSPENSE NOT
+13 ; CLOSED Screen Service for Consult Tracking
+14 ; (per Jerry)
+15 ;
+16 ; TH - patch 85 - 2/20/04 Fix bug-overwrite Initial Action Date,
+17 ; Note, and DUZ problem.
+18 ;
+19 ; KAM - patch 85 - 3/16/04 Allow forwarding of a consult to a "Tracker
+20 ; Only" service
+21 ; KAM - patch 97 - 8/19/04 Stop canceling the original consult when
+22 ; canceling the clone (in file 123)
+23 ;
+24 ;Patch 80 -Read File 123.5 DBIA 3861
+25 ; RGB - patch 206- 9/09/20 Ensure user linking an order to a Suspense
+26 ; entry sees that another user has the Suspense
+27 ; entry locked. Also, modified all other protocols
+28 ; with similar lock check message handling.
+29 ;
EN ;Add Manual Suspense
+1 ;
+2 ; VSR (RN) patch RMPR*3.0*200 change four slashes to three slashes for validation before filing adding back tic to station
+3 DO NOW^%DTC
SET X=%
+4 SET DIC="^RMPR(668,"
SET DIC(0)="AEQLM"
SET DLAYGO=668
+5 SET DIC("DR")="1////^S X=RMPRDFN;22R;14////^S X=""O"";8////^S X=DUZ;9////^S X=5;3////^S X=9;2///^S X=""`""_RMPR(""STA"")"
+6 KILL DINUM,D0,DD,DO
DO FILE^DICN
KILL DLAYGO
if Y'>0
GOTO EX
SET (RDA,DA)=+Y
+7 SET DIE="^RMPR(668,"
SET DR="13;4"
+8 ;RMPR*3*206
LOCK +^RMPR(668,RDA,0):1
IF $TEST=0
WRITE " <Another user is editing this entry>"
HANG 2
GOTO EX
+9 DO ^DIE
LOCK -^RMPR(668,RDA,0)
+10 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
+1 QUIT
+2 ;
EN2 ;edit MANUAL suspense record
+1 ;DA must be defined
+2 ;
+3 IF $PIECE(^RMPR(668,DA,0),U,8)'>4
WRITE !!!,"Can Not Edit This Suspense Record!",!!
HANG 2
QUIT
PROC ;RMPR*3*206
LOCK +^RMPR(668,DA):1
IF $TEST=0
WRITE " <Another user is editing this entry>"
HANG 2
QUIT
+1 SET RO=$GET(^RMPR(668,DA,0))
SET Y=$PIECE(^(0),U,1)
XECUTE ^DD("DD")
+2 WRITE " ",Y," ",$EXTRACT($PIECE(^DPT($PIECE(RO,U,2),0),U,1),1,20)
+3 ;
+4 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"")"
+5 XECUTE RZ
+6 WRITE " ",RR," ",$SELECT($PIECE(RO,U,5)?7N.N:"CLOSED",1:"OPEN")
+7 SET DIE="^RMPR(668,"
+8 ;Q:$D(RMPRFLAG)!$D(RMPRCLOS)!$D(FLAG)
+9 SET DR="2R;22R;3;13;4"
+10 DO ^DIE
+11 LOCK -^RMPR(668,DA)
+12 QUIT
ENIA ;initial action note
+1 ;
+2 IF $DATA(^RMPR(668,DA,3))
WRITE !!!,"Initial Action Note Already Posted!",!!
HANG 2
QUIT
+3 ;RMPR*3*206
LOCK +^RMPR(668,DA):1
IF $TEST=0
WRITE " <Another user is editing this entry>"
HANG 2
QUIT
+4 DO NOW^%DTC
SET RMPREODT=%
+5 ;link suspense to 2319 record, patch #62
+6 IF $DATA(^TMP($JOB,"RMPRPCE",660))
SET ^TMP($JOB,"RMPRPCE",668,DA)=""
DO SEL60^RMPRPCEL
+7 SET DIE="^RMPR(668,"
+8 SET DR="7"
+9 DO ^DIE
+10 IF $DATA(^RMPR(668,DA,3))
SET DR="10////^S X=RMPREODT;16////^S X=DUZ;14///^S X=""P"""
DO ^DIE
+11 LOCK -^RMPR(668,DA)
+12 ;check for a note here
+13 IF '$DATA(^RMPR(668,DA,3))
QUIT
+14 ;consult ien
+15 SET GMRCO=$PIECE(^RMPR(668,DA,0),U,15)
if GMRCO=""
QUIT
+16 ;note in array
+17 SET RMPRCMT=0
SET GMRCMT=1
+18 FOR
SET RMPRCMT=$ORDER(^RMPR(668,DA,3,RMPRCMT))
if RMPRCMT=""
QUIT
Begin DoDot:1
+19 SET GMRCMT(RMPRCMT)=^RMPR(668,DA,3,RMPRCMT,0)
End DoDot:1
+20 IF $GET(GMRCMT(1))=""
SET GMRCMT(1)="nothing noted"
+21 ;call api
+22 DO CMT^GMRCGUIB(GMRCO,.GMRCMT,DUZ,RMPREODT,DUZ)
+23 KILL RMPREODT,GMRCO,RMGMRCO,GMRCMT,RMPRCMT
+24 QUIT
FORW ;forward consult
+1 IF $PIECE(^RMPR(668,DA,0),U,8)>4
WRITE !!!,"Can Not Forward.",!!
HANG 2
QUIT
+2 IF $DATA(^RMPR(668,DA,4,1,0))
WRITE !!!,"Completion Note Already Posted!",!!
HANG 2
QUIT
+3 DO NOW^%DTC
SET RMPREODT=%
SET GMRCAD=%
+4 ;lookup service to forward consult
+5 ;S DIC("S")="I '$P(^(0),U,2),'+$G(^GMR(123.5,+Y,""IFC""))" ;*85
+6 ;*85
SET DIC("S")="I $$SCR^RMPREOS(+Y,DUZ)"
+7 SET DIC="^GMR(123.5,"
SET DIC(0)="AEQ"
+8 SET DIC("A")="Select Service To Forward Consult: "
+9 DO ^DIC
+10 IF (+Y'>0)!($DATA(DTOUT))!$DATA(DUOUT)
WRITE !!,"Not Forwarded! No Service Selected ."
HANG 2
KILL DIC
QUIT
+11 SET GMRCSS=+Y
+12 ;RMPR*3*206
LOCK +^RMPR(668,DA):1
IF $TEST=0
WRITE " <Another user is editing this entry>"
HANG 2
+13 SET DIE="^RMPR(668,"
+14 ;stuff Consult forward service
+15 SET DR="23////^S X=GMRCSS"
+16 DO ^DIE
+17 if '$PIECE($GET(^RMPR(668,DA,8)),U,6)
QUIT
+18 SET DR="12"
+19 DO ^DIE
+20 IF $DATA(^RMPR(668,DA,4,1,0))
SET DR="5////^S X=RMPREODT;6////^S X=DUZ;14///^S X=""C"""
DO ^DIE
+21 ;must have a note
+22 IF '$DATA(^RMPR(668,DA,4,1,0))
WRITE !!,"Must Have Note to Forward. Consult Not Forwarded."
SET $PIECE(^RMPR(668,DA,8),U,6)=""
HANG 2
QUIT
+23 ;
+24 ; set initial action note if null
+25 ;I '$P(^RMPR(668,DA,0),U,10) D
+26 ;
+27 ; Check if Initial Action Date is null
+28 IF $PIECE(^RMPR(668,DA,0),U,9)=""
Begin DoDot:1
+29 SET DIE="^RMPR(668,"
+30 ; Set Initial Action Note
+31 SET DR="7///^S X=""See Completion Note, this was forwarded to another service."""
+32 DO ^DIE
+33 ; Set Initial Action Date and Initial Action By
+34 ;S DR="10////^S X=RMPREODT;16////^S X=DUZ;24////^S X=DUZ" D ^DIE
+35 SET DR="10////^S X=RMPREODT;16////^S X=DUZ"
DO ^DIE
End DoDot:1
+36 ;
+37 ; Set Forwarded By
+38 SET DR="24////^S X=DUZ"
DO ^DIE
+39 ;
+40 LOCK -^RMPR(668,DA)
+41 KILL RMPREODT
+42 SET GMRCO=$PIECE(^RMPR(668,DA,0),U,15)
+43 if GMRCO=""
QUIT
+44 ;note in array
+45 SET RMPRCOM=0
+46 FOR
SET RMPRCOM=$ORDER(^RMPR(668,DA,4,RMPRCOM))
if RMPRCOM=""
QUIT
Begin DoDot:1
+47 SET GMRCOM(RMPRCOM)=^RMPR(668,DA,4,RMPRCOM,0)
End DoDot:1
+48 IF $GET(GMRCOM)=""
SET GMRCOM="not noted"
+49 SET GMRCORNP=DUZ
+50 SET GMRCURGI=""
+51 SET GMRCATTN=""
+52 SET BDC=$$FR^GMRCGUIA(.GMRCO,.GMRCSS,.GMRCORNP,.GMRCATTN,.GMRCURGI,.GMRCOM,.GMRCAD)
+53 IF +BDC=1
WRITE !!,"ERROR, DID NOT FORWARD!"
HANG 2
+54 WRITE !!,"Consult Forwarded."
HANG 2
+55 KILL GMRCO,GMRCSS,GMRCORNP,GMRCATTN,GMRCURGI,GMRCOM,GMRCAD
+56 QUIT
CLNT ;post closed note
+1 ;
+2 IF $PIECE(^RMPR(668,DA,0),U,10)="C"
WRITE !!!,"Completion Note Already Posted!",!!
HANG 2
QUIT
+3 ;RMPR*3*206
LOCK +^RMPR(668,DA):1
IF $TEST=0
WRITE " <Another user is editing this entry>"
HANG 2
QUIT
+4 DO NOW^%DTC
SET RMPREODT=%
SET GMRCAD=%
+5 ;link suspense to 2319 record, patch #62
+6 IF $DATA(^TMP($JOB,"RMPRPCE",660))
SET ^TMP($JOB,"RMPRPCE",668,DA)=""
DO SEL60^RMPRPCEL
+7 SET DIE="^RMPR(668,"
+8 SET DR="12"
+9 DO ^DIE
+10 IF '$DATA(^RMPR(668,DA,4))
QUIT
+11 IF $DATA(^RMPR(668,DA,4))
SET DR="5////^S X=RMPREODT;6////^S X=DUZ;14///^S X=""C"""
DO ^DIE
+12 ;set initial action note if null
+13 IF '$PIECE(^RMPR(668,DA,0),U,9)
Begin DoDot:1
+14 SET DIE="^RMPR(668,"
+15 SET DR="7///^S X=""See Completion Note for Initial Action Taken."""
+16 DO ^DIE
+17 SET DR="10////^S X=RMPREODT;16////^S X=DUZ"
DO ^DIE
End DoDot:1
+18 ;added by #62. Once closed, update all 2319 record for initial and
+19 ;completion date
+20 DO ICDT^RMPRPCEL(DA)
+21 ;
+22 LOCK -^RMPR(668,DA)
+23 KILL RMPREODT
+24 SET GMRCO=$PIECE(^RMPR(668,DA,0),U,15)
+25 if GMRCO=""
QUIT
+26 ;note in array
+27 SET RMPRCOM=0
+28 FOR
SET RMPRCOM=$ORDER(^RMPR(668,DA,4,RMPRCOM))
if RMPRCOM=""
QUIT
Begin DoDot:1
+29 SET GMRCOM(RMPRCOM)=^RMPR(668,DA,4,RMPRCOM,0)
End DoDot:1
+30 IF $GET(GMRCOM)=""
SET GMRCOM="not noted"
+31 SET GMRCSF="U"
+32 SET GMRCA=10
+33 SET GMRCALF="N"
+34 SET GMRCATO=""
+35 SET (GMRCORNP,GMRCDUZ)=DUZ
+36 SET BDC=$$SFILE^GMRCGUIB(.GMRCO,.GMRCA,.GMRCSF,.GMRCORNP,.GMRCDUZ,.GMRCOM,.GMRCALF,.GMRCATO,.GMRCAD)
+37 IF +BDC=1
WRITE !!,$PIECE(BDC,U,2)
HANG 2
+38 KILL GMRCO,GMRCA,GMRCSF,GMRCORNP,GMRCDUZ,GMRCOM,GMRCALF,GMRCATO,GMRCAD
+39 QUIT
OACT ;other notes - no initial needed 3/12/01
+1 ;stuff date/time in.01
+2 ;delete if no note
+3 ;I '$D(^RMPR(668,DA,3,1,0)) W !!!,"No Initial Action Taken... ",!! H 2 Q
+4 ;
+5 ;RMPR*3*206
LOCK +^RMPR(668,DA):1
IF $TEST=0
WRITE " <Another user is editing this entry>"
HANG 2
QUIT
+6 ;link suspense to 2319 record, patch #62
+7 IF $DATA(^TMP($JOB,"RMPRPCE",660))
SET ^TMP($JOB,"RMPRPCE",668,DA)=""
DO SEL60^RMPRPCEL
+8 SET DA(1)=DA
SET RMPRDA1=DA
+9 SET DIC="^RMPR(668,"_DA(1)_",1,"
+10 SET DIC(0)="CQL"
+11 SET DIC("P")=$PIECE(^DD(668,11,0),U,2)
+12 DO NOW^%DTC
SET X=%
SET GMRCWHN=%
+13 SET DLAYGO=688
+14 DO ^DIC
+15 IF Y=-1
KILL DIC,DA
QUIT
+16 SET DIE=DIC
KILL DIC
+17 SET (DA,RMPRDA2)=+Y
+18 SET DR="1"
DO ^DIE
+19 KILL DIE,DR,Y
+20 IF '$DATA(^RMPR(668,RMPRDA1,1,RMPRDA2,1,0))
Begin DoDot:1
+21 ;delete the record if no note
+22 SET DIK="^RMPR(668,RMPRDA1,1,"
+23 SET DA=RMPRDA2
+24 DO ^DIK
+25 KILL DA,DIA,RMPRDA1,RMPRDA2,GMRCWHN
End DoDot:1
QUIT
+26 ;send data to consults if note
+27 SET GMRCO=$PIECE(^RMPR(668,RMPRDA1,0),U,15)
+28 IF GMRCO=""
QUIT
+29 ;GMRCOM is comment array
+30 SET RMPRCOM=0
+31 FOR
SET RMPRCOM=$ORDER(^RMPR(668,RMPRDA1,1,RMPRDA2,1,RMPRCOM))
if RMPRCOM=""
QUIT
Begin DoDot:1
+32 SET GMRCOM(RMPRCOM)=^RMPR(668,RMPRDA1,1,RMPRDA2,1,RMPRCOM,0)
End DoDot:1
+33 ;
+34 LOCK -^RMPR(668,RMPRDA1)
+35 ;GMRCWHN was set to date/time
+36 DO CMT^GMRCGUIB(.GMRCO,.GMRCOM,"",.GMRCWHN,DUZ)
+37 ;check ok
+38 KILL DA,DIK,RMPRDA1,RMPRDA2,RMPRCOM,GMRCOM,GMRCO,GMRCWHN
+39 QUIT
CANCEL ;cancel suspense
+1 ;set status to X and cancelled by to duz, date/time.
+2 ;start
+3 ;
+4 IF $PIECE(^RMPR(668,DA,0),U,5)'=""
WRITE !!!,"This has already been completed, cannot cancel!",!!
HANG 2
QUIT
+5 ;RMPR*3*206
LOCK +^RMPR(668,DA):1
IF $TEST=0
WRITE " <Another user is editing this entry>"
HANG 2
QUIT
+6 KILL Y
+7 SET DIR(0)="Y"
SET DIR("B")="N"
+8 WRITE !!!,"This will CANCEL/DELETE this Suspense Request."
+9 SET DIR("A")="Are you sure you want to CANCEL/DELETE this Suspense Request? (Y/N) "
+10 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="^")!(Y=0)
WRITE !!,"Suspense Not Cancelled!"
HANG 2
QUIT
+11 DO NOW^%DTC
SET RMPREODT=%
+12 SET DIE="^RMPR(668,"
+13 SET DR="14///^S X=""X"";17////^S X=DUZ;18////^S X=RMPREODT;9"
+14 DO ^DIE
+15 WRITE !!,?5,"DELETED/CANCELLED!"
HANG 2
+16 LOCK -^RMPR(668,DA)
+17 ;consult ien
+18 SET GMRCO=$PIECE(^RMPR(668,DA,0),U,15)
if GMRCO=""
QUIT
+19 ;note in array
+20 SET RMPRCMT=0
+21 FOR
SET RMPRCMT=$ORDER(^RMPR(668,DA,9,RMPRCMT))
if RMPRCMT=""
QUIT
Begin DoDot:1
+22 SET GMRCMT(RMPRCMT)=^RMPR(668,DA,9,RMPRCMT,0)
End DoDot:1
+23 IF $GET(GMRCMT)=""
SET GMRCMT="nothing noted"
+24 ;call api
+25 ;DY for cancelled, deny
+26 SET GMRCACTM="DY"
+27 ; PATCH RMPR*3*97 if canceling a clone do not update file 123 7=clone
+28 IF $PIECE(^RMPR(668,DA,0),U,8)'=7
Begin DoDot:1
+29 SET RMGMRCO=$$DC^GMRCGUIA(.GMRCO,DUZ,RMPREODT,.GMRCACTM,.GMRCMT)
End DoDot:1
+30 KILL RMPREODT,GMRCMT,RMPRCMT,GMRCACTM
+31 QUIT
+32 ;
LINK60 ;link suspense to 2319 records
+1 SET RMSERR=0
+2 FOR RMSI=0:0
SET RMSI=$ORDER(^TMP($JOB,"RMPRPCE",660,RMSI))
if RMSI'>0
QUIT
Begin DoDot:1
+3 SET RMSAMIS=$GET(^TMP($JOB,"RMPRPCE",660,RMSI))
+4 ;call update 668
+5 SET RMSERR=$$UP68^RMPRPCE1(RMSI,DA,+RMSAMIS)
End DoDot:1
+6 if RMSERR=1
QUIT
+7 SET ^TMP($JOB,"RMPRPCE",668,DA)=""
+8 QUIT
+9 ;end
SCR(SERV,USR) ; SCREEN SERVICES THAT CAN BE FORWARDED TO ,RMPR*3*85
+1 NEW USAGE
+2 SET USAGE=$PIECE(^GMR(123.5,SERV,0),U,2)
+3 ;disabled or grouper service
IF USAGE=9!(USAGE=1)
QUIT 0
+4 ;tracking and check update user
IF USAGE=2
QUIT $$VALIDU^GMRCAU(SERV,USR)
+5 ;service usage must be null = O
QUIT 1
