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