source: FOIAVistA/tag/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRS.m@ 1700

Last change on this file since 1700 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1RMPRS ;PHX/HNC/RFM,RVD-ADD SUSPENSE RECORD ;8/29/1994
2 ;;3.0;PROSTHETICS;**26,28,30,45,52,62,120**;Feb 09, 1996
3 ;
4 ; HNC - patch 52 - 9/22/00 Modify INQ - sub.
5 ; Add KILL^XUSCLEAN on exit to kill
6 ; all variables.
7 ; HNC - patch 52 - 10/5/00 New RMPR,RMPRNAM,RMPRDOB,RMPRSSN,RMPRSSNE
8 ; RMPRCNUM before appt mgt
9 ; RVD - patch 62 - 10/13/01 remove link to Patient Management
10 ; call rotine RMPREOL
11 ; suspense print message
12 ;
13EN ;ADD SUSPENSE RECORD
14 D DIV4^RMPRSIT G:$D(X) EXIT
15 S DIC="^DPT(",DIC(0)="AEQM" D ^DIC G:Y'>0 EXIT S RMPRDFN=+Y
16 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
17 S DIE="^RMPR(668,",DR="3;4"
18 L +^RMPR(668,RDA,0):1 I $T=0 W $C(7),?5,!,"Someone else is editing this record" G EX
19 D ^DIE L -^RMPR(668,RDA,0)
20 I '$P(^RMPR(668,RDA,0),U,3) S DA=RDA,DIK="^RMPR(668," D ^DIK W !,$C(7),?5,"Deleted..."
21EX K X,DIC,DIE,DR,Y,RMPRDFN G EN
22CL ;CLOSE OUT SUSPENSE RECORD
23 D DIV4^RMPRSIT G:$D(X) EXIT
24 K DIE,DR,Y,DA,RMPRA,^TMP("RMSU",$J)
25 S RMPRCLOS=1 D DICDPT S (I,RMTOI)=0 G:Y<0!($D(DTOUT))!(Y="^") EXIT
26 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
27 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
28 S RMPRA=IEN,DR="2;4;7",DA=IEN,DIE=DIC D ^DIE G:$D(Y) EX1
29 S DR="5//^S X=DT;6////^S X=DUZ",DA=RMPRA D ^DIE L -^RMPR(668,RMPRA,0)
30EX1 I '$P(^RMPR(668,RMPRA,0),U,5) W !!,"SUSPENSE RECORD WAS NOT CLOSED OUT",$C(7) S $P(^(0),U,6)=""
31 W ! G CL
32EXIT 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
33EN2 ;EDIT SUSPENSE RECORD
34 D DIV4^RMPRSIT G:$D(X) EXIT
35 D DICDPT G:Y<0!($D(DTOUT))!(Y="^") EXIT
36 ;
37 ;
38REV ;reverse look-up.--HNC--change to $O(^RMPR(668,"C",ien,n),-1)
39ENT ;sort/display
40 S (RMI,RML,RMTOI,RMQUIT,IEN,RMSEL,OUT)=0
41 W !,"CHOOSE FROM:"
42 S RMPRJ=""
43 F S RMPRJ=$O(^RMPR(668,"C",RMPRDFN,RMPRJ),-1) Q:RMPRJ="" Q:OUT=1 Q:IEN>0 D
44 .S RMTOI=RMTOI+1
45 .S RMI=RMI+1
46 .;S RML=RML+1
47 .S ^TMP("RMSU",$J,RMI)=RMPRDFN_U_RMPRJ
48 .I $Y>20 D DIS W @IOF Q
49 .D WRI
50 .Q:(RMQUIT)!(IEN)!(RMSEL)
51 G:RMSEL ENT
52 G:IEN PROC
53 I 'RMI W !!,"***** PATIENT HAS NO SUSPENSE RECORD!!!!" Q
54 ;I RMQUIT W !!,"***** NO SELECTION MADE!!!" Q
55 D DIS
56 ;W !!,"[<return> or '^' to Quit] or Choose Number 1-",RMI W ": " R X:DTIME I '$T Q
57 ;I X=""!(X="^")!('$D(X)) W !!,"***** NO SELECTION MADE!!!" Q
58 ;I '$D(^TMP("RMSU",$J,+X)) W !,$C(7),"****INVALID RESPONSE, Please choose a NUMBER within the range!!!!" G ENT
59 ;S IEN=$P(^TMP("RMSU",$J,+X),U,2)
60 Q
61 ;
62PROC ;
63 L +^RMPR(668,IEN,0):1 I $T=0 W !,?5,$C(7),"Someone else is Editing this entry!" Q
64 ;
65 S Y=""
66 S RO=$G(^RMPR(668,+IEN,0)),Y=$P(^(0),U,1)
67 W " ",$$DAT1^RMPRUTL1(Y)
68 S DFN=RMPRDFN D DEM^VADPT
69 W " ",VADM(1)
70 W " ",$$STATUS^RMPREOU(+IEN)
71 S Y=+IEN
72 S DIC="^RMPR(668,"
73 Q:$D(RMPRFLAG)!$D(RMPRCLOS)!$D(FLAG)
74 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)=""
75 L -^RMPR(668,IEN,0) G EN2
76 ;
77INQ ;Inquire to Suspense entry point
78 ;
79 W @IOF
80 D DIV4^RMPRSIT G:$D(X) EXIT
81 D HOME^%ZIS
82 S RMPRFLAG=1
83 ;get patient dfn
84 D DICDPT I Y'>0!($D(DTOUT))!(Y="^") K RMPRDFN G EXIT
85 S RMPRDFN=+Y
86 D REV I 'IEN K RMPRDFN G EXIT
87 ;call new suspense processing
88 N RMPREOY,DA
89 S (RMPREOY,DA)=IEN D VIEWCP^RMPREO23
90 ;clean up - patch 52
91 D KILL^XUSCLEAN
92 Q
93 ;
94EXT S RO=0 F S RO=$O(^RMPR(668,IEN,2,RO)) Q:RO'>0 W !,^RMPR(668,IEN,2,RO,0)
95 Q
96 ;
97ACT W !!,"ACTION TAKEN: "
98 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)
99 E W "NONE RECORDED"
100 W ! Q
101LINK ;CLOSE OUT SUSPENSE ENTRY FOR SELECTED PATIENT
102 ;call routine RMPREOL if PCE link to suspense, patch #62.
103SUSP I $D(^TMP($J,"RMPRPCE",660)) D EN^RMPREOL,FULL^VALM1 Q
104 I '$D(^TMP($J,"RMPRPCE",660)) D EN^RMPREO
105 D FULL^VALM1
106 Q
107 ;add new module HNC 3-2-00
108 N Y,RO,RR,RT,RX,RZ,J,RB,RIE,RD,RI,FLAG K ^TMP("RMSU",$J)
109 Q:'$D(RMPRDFN) Q:'$D(^RMPR(668,"C",RMPRDFN))
110 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"")"
111 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
112 Q:'$D(FLAG)
113 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
114 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
115 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
116 I $D(DTOUT)!($D(DUOUT)) G EXIT
117 G LINK
118 ;
119WRI ;write
120 ;called from ENT, rmprdfn, rmprj defined
121 N RMPR668
122 S RO=$G(^RMPR(668,RMPRJ,0)),RMPR668=RMPRJ,Y=$P(^(0),U,1)
123 W !,RMI,".",?5,$$DAT1^RMPRUTL1(Y)
124 S DFN=$P(RO,U,2) D DEM^VADPT
125 W ?16,$E(VADM(1),1,19)
126 W ?37,$$STATUS^RMPREOU(RMPR668,9)
127 ;display first part of description
128 I $D(^RMPR(668,RMPR668,2,1,0)) W ?48,$E(^RMPR(668,RMPR668,2,1,0),1,31)
129 Q
130DIS ;continue
131 K DIR S DIR(0)="NO^1:"_RMI_":0" D ^DIR
132 I $D(DUOUT) S OUT=1 Q
133 I Y>0 S IEN=$P(^TMP("RMSU",$J,+Y),U,2)
134 Q
135 ;
136DICDPT ;ask patient from file #2
137 ;
138 K DIC,^TMP("RMSU",$J)
139 S DIC="^DPT(",DIC(0)="AEQMZ"
140 S DIC("A")="Select PATIENT: " D ^DIC Q
141 ;
142 ;added in patch #62
143SMESS ;print message for mandatory suspense entry.
144 ;W !!,"*********************************************************"
145 ;W !,"** No suspense record has been selected for this **"
146 ;W !,"** transaction. You must POST INITIAL ACTION, POST **"
147 ;W !,"** OTHER ACTION or POST COMPLETE suspense in order to **"
148 ;W !,"** complete this transaction, otherwise transaction **"
149 ;W !,"** will not be linked to SUSPENSE.................. **"
150 ;W !,"*********************************************************"
151 ;W !!
152 ;K DIR
153 ;S DIR(0)="SBO^L:LINK Suspense to Patient Record;E:EXIT without linking to Suspense"
154 ;S DIR("A")="Would you like to LINK Suspense or EXIT without linking"
155 ;S DIR("B")="L"
156 ;S DIR("?")="Answer `L` to Link to suspense, 'E' to exit without link to suspense"
157 ;D ^DIR S RMENTSUS=Y
158 ;I $D(DIRUT)!$D(DUOUT)!$D(DTOUT) S RMENTSUS="E"
159 ;W !! K DIR
160 ;Q
Note: See TracBrowser for help on using the repository browser.