254 lines
5.7 KiB
Mathematica
254 lines
5.7 KiB
Mathematica
RMPREO23 ;HINES/HNC ;suspense processing display protocols ;10/9/2003
|
|
;;3.0;PROSTHETICS;**45,55,62,77,80**;Feb 09, 1996
|
|
; RVD 1/16/01 #62 -added a selected range for linked suspense
|
|
; for initial, post other and complete action only.
|
|
;RVD patch #77 - check for ^tmp global and XRMPRDFN variable
|
|
Q
|
|
DIS ;display 2319 action
|
|
S RMPRBAC1=1
|
|
D FULL^VALM1
|
|
S XRMPRDFN=RMPRDFN
|
|
D ^RMPRPAT
|
|
K RMPRBAC1,RMPRBACK
|
|
S VALMBCK="R"
|
|
Q:'$D(XRMPRDFN)
|
|
S (RMPRDFN,DFN)=XRMPRDFN D DEM^VADPT
|
|
S RMPRNAM=$P(VADM(1),U,1)
|
|
S RMPRDOB=$P(VADM(3),U,1)
|
|
S RMPRSSN=$P(VADM(2),U,1)
|
|
K VADM,XRMPRDFN
|
|
Q
|
|
;
|
|
CHG ;change patient
|
|
D FULL^VALM1
|
|
S XRMPRDFN=RMPRDFN
|
|
D GETPAT^RMPRUTIL
|
|
I '$D(RMPRDFN) S RMPRDFN=XRMPRDFN
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
CANCEL ;cancel suspense
|
|
D FULL^VALM1
|
|
D NUM^RMPREOU
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D CANCEL^RMPREOS
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
VIEW ;view consult request
|
|
N YY,DA,FLDS,DIC
|
|
D FULL^VALM1
|
|
D NUM^RMPREOU
|
|
I Y="" S VALMBCK="R"
|
|
;
|
|
S RN=1,XDA=""
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 D VIEWP
|
|
K RMPREOY,DUOUT
|
|
S VALMBCK="R"
|
|
Q
|
|
VIEWP ;
|
|
;
|
|
Q:'$D(^TMP($J,"RMPREOEE",XDA,0))
|
|
S DA=^TMP($J,"RMPREOEE",XDA,0)
|
|
S L=0
|
|
S DIC="^RMPR(668,",FLDS="[RMPR VIEW REQUEST]"
|
|
S BY="@NUMBER",(FR,TO)=DA
|
|
;prompt for device
|
|
;S IOP="HOME"
|
|
D EN1^DIP
|
|
N DIR S DIR(0)="E" D ^DIR
|
|
W @IOF
|
|
S DA=^TMP($J,"RMPREOEE",XDA,0)
|
|
D VALL^RMPREO24(DA,.L) Q:L="^"
|
|
Q
|
|
;
|
|
PDISP ;print consultaton sheet
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D PDISPA
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
PDISPA ;call consult api
|
|
;pass DA ien to 668
|
|
D ENP^RMPREPDT
|
|
Q
|
|
DDISP ;detail display
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D DDISPA
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
DDISPA ;call list template from listmanager
|
|
;pass DA ien to file 668
|
|
D EN^RMPREPDT
|
|
Q
|
|
VIEWIA ;view initial action note
|
|
N YY,DIC,BY,FLDS,FR,TO,DA
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
;
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D VIEWIAP
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
S VALMBCK="R"
|
|
Q
|
|
VIEWIAP ;loop
|
|
S L=0
|
|
S DIC="^RMPR(668,",FLDS="[RMPR VIEW INITIAL ACTION]"
|
|
S BY="@NUMBER",(FR,TO)=DA
|
|
S IOP="HOME"
|
|
W @IOF
|
|
D EN1^DIP
|
|
N DIR S DIR(0)="E" D ^DIR
|
|
Q
|
|
;
|
|
VIEWC ;view complete note
|
|
;
|
|
N YY,DIC,BY,FLDS,FR,TO,DA
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
;
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D VIEWCP
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
S VALMBCK="R"
|
|
Q
|
|
VIEWCP ;loop
|
|
S L=0
|
|
S DIC="^RMPR(668,",FLDS="[RMPR VIEW COMP NOTE]"
|
|
S BY="@NUMBER",(FR,TO)=DA
|
|
;should we ask device?
|
|
;S IOP="HOME"
|
|
W @IOF
|
|
D EN1^DIP
|
|
N DIR S DIR(0)="E" D ^DIR
|
|
Q
|
|
;
|
|
;
|
|
VIEWO ;view other action notes
|
|
N YY,DIC,BY,FLDS,FR,TO,DA
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D VIEWOP
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
S VALMBCK="R"
|
|
Q
|
|
VIEWOP ;loop
|
|
S L=0
|
|
S DIC="^RMPR(668,",FLDS="[RMPR OACT NOTE]"
|
|
S BY="@NUMBER",(FR,TO)=DA
|
|
S IOP="HOME"
|
|
W @IOF
|
|
D EN1^DIP
|
|
N DIR S DIR(0)="E" D ^DIR
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
IACT ;take initial action
|
|
;
|
|
N YY,DIC,BY,FLDS,FR,TO,DA
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D ENIA^RMPREOS
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
I $G(RMSUCLFG) D INIT^RMPREOL
|
|
I '$G(RMSUCLFG) D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
OACT ;other notes
|
|
N YY,DIC,BY,FLDS,FR,TO,DA
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D OACT^RMPREOS
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
I $G(RMSUCLFG) D INIT^RMPREOL
|
|
I '$G(RMSUCLFG) D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
CACT ;complete note
|
|
N YY,DIC,BY,FLDS,FR,TO,DA
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D CLNT^RMPREOS
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
I $G(RMSUCLFG) D INIT^RMPREOL
|
|
I '$G(RMSUCLFG) D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
FORW ;forward consult
|
|
N YY,DIC,BY,FLDS,FR,TO,DA
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D FORW^RMPREOS
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
AMAN ;add manual suspense
|
|
D FULL^VALM1
|
|
D EN^RMPREOS
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
AAUTO ;add AUTO ADAPTIVE suspense
|
|
D FULL^VALM1
|
|
D EN^RMPREOSA
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
ACLO ;add CLOTHING ALLOWANCE suspense
|
|
D FULL^VALM1
|
|
D EN1^RMPREOSA
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
CLONE ;Create Clone CPRS Suspense
|
|
;new vars here
|
|
D NUM^RMPREOU
|
|
D FULL^VALM1
|
|
S RMPREOY=Y
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D CLONEP
|
|
K RMPREOY,XDA,DA,DUOUT
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
CLONEP ;Create Clone CPRS from loop
|
|
D EN2^RMPREOSA
|
|
Q
|
|
;
|
|
EMAN ;edit manual suspense
|
|
D FULL^VALM1
|
|
D NUM^RMPREOU
|
|
S RMPREOY=Y
|
|
S RN=""
|
|
F RN=1:1 S XDA=$P(RMPREOY,",",RN) Q:XDA="" Q:$G(DUOUT)=1 I $D(^TMP($J,"RMPREOEE",XDA,0)) S DA=^TMP($J,"RMPREOEE",XDA,0) D EMANP
|
|
K RMPREOY,XDA,DA,DUOUT,RN
|
|
Q
|
|
EMANP ;edit manual supsense loop
|
|
D EN2^RMPREOS
|
|
D INIT^RMPREO
|
|
S VALMBCK="R"
|
|
Q
|
|
;
|
|
;END
|