Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RMPRS

RMPRS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; HNC - patch 52 - 9/22/00 Modify INQ - sub.
  1. ; Add KILL^XUSCLEAN on exit to kill
  1. ; all variables.
  1. ; HNC - patch 52 - 10/5/00 New RMPR,RMPRNAM,RMPRDOB,RMPRSSN,RMPRSSNE
  1. ; RMPRCNUM before appt mgt
  1. ; RVD - patch 62 - 10/13/01 remove link to Patient Management
  1. ; call routine RMPREOL
  1. ; suspense print message
  1. ;
  1. 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
  1. D DIV4^RMPRSIT G:$D(X) EXIT
  1. S DIC="^DPT(",DIC(0)="AEQM" D ^DIC G:Y'>0 EXIT S RMPRDFN=+Y
  1. 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
  1. S DIE="^RMPR(668,",DR="3;4"
  1. L +^RMPR(668,RDA,0):1 I $T=0 W $C(7),?5,!,"Someone else is editing this record" G EX
  1. D ^DIE L -^RMPR(668,RDA,0)
  1. I '$P(^RMPR(668,RDA,0),U,3) S DA=RDA,DIK="^RMPR(668," D ^DIK W !,$C(7),?5,"Deleted..."
  1. EX K X,DIC,DIE,DR,Y,RMPRDFN G EN
  1. CL ;CLOSE OUT SUSPENSE RECORD
  1. D DIV4^RMPRSIT G:$D(X) EXIT
  1. K DIE,DR,Y,DA,RMPRA,^TMP("RMSU",$J)
  1. S RMPRCLOS=1 D DICDPT S (I,RMTOI)=0 G:Y<0!($D(DTOUT))!(Y="^") EXIT
  1. 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
  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
  1. S RMPRA=IEN,DR="2;4;7",DA=IEN,DIE=DIC D ^DIE G:$D(Y) EX1
  1. S DR="5//^S X=DT;6////^S X=DUZ",DA=RMPRA D ^DIE L -^RMPR(668,RMPRA,0)
  1. EX1 I '$P(^RMPR(668,RMPRA,0),U,5) W !!,"SUSPENSE RECORD WAS NOT CLOSED OUT",$C(7) S $P(^(0),U,6)=""
  1. W ! G CL
  1. 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
  1. EN2 ;EDIT SUSPENSE RECORD
  1. D DIV4^RMPRSIT G:$D(X) EXIT
  1. D DICDPT G:Y<0!($D(DTOUT))!(Y="^") EXIT
  1. ;
  1. ;
  1. REV ;reverse look-up.--HNC--change to $O(^RMPR(668,"C",ien,n),-1)
  1. ENT ;sort/display
  1. S (RMI,RML,RMTOI,RMQUIT,IEN,RMSEL,OUT)=0
  1. W !,"CHOOSE FROM:"
  1. S RMPRJ=""
  1. F S RMPRJ=$O(^RMPR(668,"C",RMPRDFN,RMPRJ),-1) Q:RMPRJ="" Q:OUT=1 Q:IEN>0 D
  1. .S RMTOI=RMTOI+1
  1. .S RMI=RMI+1
  1. .;S RML=RML+1
  1. .S ^TMP("RMSU",$J,RMI)=RMPRDFN_U_RMPRJ
  1. .I $Y>20 D DIS W @IOF Q
  1. .D WRI
  1. .Q:(RMQUIT)!(IEN)!(RMSEL)
  1. G:RMSEL ENT
  1. G:IEN PROC
  1. I 'RMI W !!,"***** PATIENT HAS NO SUSPENSE RECORD!!!!" Q
  1. ;I RMQUIT W !!,"***** NO SELECTION MADE!!!" Q
  1. D DIS
  1. ;W !!,"[<return> or '^' to Quit] or Choose Number 1-",RMI W ": " R X:DTIME I '$T Q
  1. ;I X=""!(X="^")!('$D(X)) W !!,"***** NO SELECTION MADE!!!" Q
  1. ;I '$D(^TMP("RMSU",$J,+X)) W !,$C(7),"****INVALID RESPONSE, Please choose a NUMBER within the range!!!!" G ENT
  1. ;S IEN=$P(^TMP("RMSU",$J,+X),U,2)
  1. Q
  1. ;
  1. PROC ;
  1. L +^RMPR(668,IEN,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" Q
  1. ;
  1. S Y=""
  1. S RO=$G(^RMPR(668,+IEN,0)),Y=$P(^(0),U,1)
  1. W " ",$$DAT1^RMPRUTL1(Y)
  1. S DFN=RMPRDFN D DEM^VADPT
  1. W " ",VADM(1)
  1. W " ",$$STATUS^RMPREOU(+IEN)
  1. S Y=+IEN
  1. S DIC="^RMPR(668,"
  1. Q:$D(RMPRFLAG)!$D(RMPRCLOS)!$D(FLAG)
  1. 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)=""
  1. L -^RMPR(668,IEN,0) G EN2
  1. ;
  1. INQ ;Inquire to Suspense entry point
  1. ;
  1. W @IOF
  1. D DIV4^RMPRSIT G:$D(X) EXIT
  1. D HOME^%ZIS
  1. S RMPRFLAG=1
  1. ;get patient dfn
  1. D DICDPT I Y'>0!($D(DTOUT))!(Y="^") K RMPRDFN G EXIT
  1. S RMPRDFN=+Y
  1. D REV I 'IEN K RMPRDFN G EXIT
  1. ;call new suspense processing
  1. N RMPREOY,DA
  1. S (RMPREOY,DA)=IEN D VIEWCP^RMPREO23
  1. ;clean up - patch 52
  1. D KILL^XUSCLEAN
  1. Q
  1. ;
  1. EXT S RO=0 F S RO=$O(^RMPR(668,IEN,2,RO)) Q:RO'>0 W !,^RMPR(668,IEN,2,RO,0)
  1. Q
  1. ;
  1. ACT W !!,"ACTION TAKEN: "
  1. 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)
  1. E W "NONE RECORDED"
  1. W ! Q
  1. ;call routine RMPREOL if PCE link to suspense, patch #62.
  1. SUSP I $D(^TMP($J,"RMPRPCE",660)) D EN^RMPREOL,FULL^VALM1 Q
  1. I '$D(^TMP($J,"RMPRPCE",660)) D EN^RMPREO
  1. D FULL^VALM1
  1. Q
  1. ;add new module HNC 3-2-00
  1. N Y,RO,RR,RT,RX,RZ,J,RB,RIE,RD,RI,FLAG K ^TMP("RMSU",$J)
  1. Q:'$D(RMPRDFN) Q:'$D(^RMPR(668,"C",RMPRDFN))
  1. 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"")"
  1. 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
  1. Q:'$D(FLAG)
  1. 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
  1. 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
  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
  1. I $D(DTOUT)!($D(DUOUT)) G EXIT
  1. G LINK
  1. ;
  1. WRI ;write
  1. ;called from ENT, rmprdfn, rmprj defined
  1. N RMPR668
  1. S RO=$G(^RMPR(668,RMPRJ,0)),RMPR668=RMPRJ,Y=$P(^(0),U,1)
  1. W !,RMI,".",?5,$$DAT1^RMPRUTL1(Y)
  1. S DFN=$P(RO,U,2) D DEM^VADPT
  1. W ?16,$E(VADM(1),1,19)
  1. W ?37,$$STATUS^RMPREOU(RMPR668,9)
  1. ;display first part of description
  1. I $D(^RMPR(668,RMPR668,2,1,0)) W ?48,$E(^RMPR(668,RMPR668,2,1,0),1,31)
  1. Q
  1. DIS ;continue
  1. K DIR S DIR(0)="NO^1:"_RMI_":0" D ^DIR
  1. I $D(DUOUT) S OUT=1 Q
  1. I Y>0 S IEN=$P(^TMP("RMSU",$J,+Y),U,2)
  1. Q
  1. ;
  1. DICDPT ;ask patient from file #2
  1. ;
  1. K DIC,^TMP("RMSU",$J)
  1. S DIC="^DPT(",DIC(0)="AEQMZ"
  1. S DIC("A")="Select PATIENT: " D ^DIC Q
  1. ;
  1. ;added in patch #62
  1. SMESS ;print message for mandatory suspense entry.
  1. ;W !!,"*********************************************************"
  1. ;W !,"** No suspense record has been selected for this **"
  1. ;W !,"** transaction. You must POST INITIAL ACTION, POST **"
  1. ;W !,"** OTHER ACTION or POST COMPLETE suspense in order to **"
  1. ;W !,"** complete this transaction, otherwise transaction **"
  1. ;W !,"** will not be linked to SUSPENSE.................. **"
  1. ;W !,"*********************************************************"
  1. ;W !!
  1. ;K DIR
  1. ;S DIR(0)="SBO^L:LINK Suspense to Patient Record;E:EXIT without linking to Suspense"
  1. ;S DIR("A")="Would you like to LINK Suspense or EXIT without linking"
  1. ;S DIR("B")="L"
  1. ;S DIR("?")="Answer `L` to Link to suspense, 'E' to exit without link to suspense"
  1. ;D ^DIR S RMENTSUS=Y
  1. ;I $D(DIRUT)!$D(DUOUT)!$D(DTOUT) S RMENTSUS="E"
  1. ;W !! K DIR
  1. ;Q