268 lines
9.2 KiB
Mathematica
268 lines
9.2 KiB
Mathematica
RMPREOS ;HINES-CIOFO/HNC -Suspense Processing ; 2/25/04 10:26am
|
|
;;3.0;PROSTHETICS;**45,50,52,55,57,62,80,85,97**;Feb 09, 1996
|
|
;
|
|
; 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
|
|
;
|
|
EN ;Add Manual Suspense
|
|
;
|
|
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 $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
|
|
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 !,?5,$C(7),"Someone else is Editing this entry!" Q
|
|
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 !,?5,$C(7),"Someone else is Editing this entry!" Q
|
|
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
|
|
F S RMPRCMT=$O(^RMPR(668,DA,3,RMPRCMT)) Q:RMPRCMT="" D
|
|
.S GMRCMT(RMPRCMT)=^RMPR(668,DA,3,RMPRCMT,0)
|
|
I $G(GMRCMT)="" S GMRCMT="nothing noted"
|
|
;call api
|
|
S RMGMRCO=$$RC^GMRCGUIA(.GMRCO,DUZ,RMPREODT,.GMRCMT,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 !,?5,$C(7),"Someone else is Editing this entry!"
|
|
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 !,?5,$C(7),"Someone else is Editing this entry!" Q
|
|
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 !,?5,$C(7),"Someone else is Editing this entry!" Q
|
|
;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 !,?5,$C(7),"Someone else is Editing this entry!" Q
|
|
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
|