- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPREO23 6081 printed Feb 19, 2025@00:00:52 Page 2
- RMPREO23 ;HINES/HNC ;suspense processing display protocols ;10/9/2003
- +1 ;;3.0;PROSTHETICS;**45,55,62,77,80**;Feb 09, 1996
- +2 ; RVD 1/16/01 #62 -added a selected range for linked suspense
- +3 ; for initial, post other and complete action only.
- +4 ;RVD patch #77 - check for ^tmp global and XRMPRDFN variable
- +5 QUIT
- DIS ;display 2319 action
- +1 SET RMPRBAC1=1
- +2 DO FULL^VALM1
- +3 SET XRMPRDFN=RMPRDFN
- +4 DO ^RMPRPAT
- +5 KILL RMPRBAC1,RMPRBACK
- +6 SET VALMBCK="R"
- +7 if '$DATA(XRMPRDFN)
- QUIT
- +8 SET (RMPRDFN,DFN)=XRMPRDFN
- DO DEM^VADPT
- +9 SET RMPRNAM=$PIECE(VADM(1),U,1)
- +10 SET RMPRDOB=$PIECE(VADM(3),U,1)
- +11 SET RMPRSSN=$PIECE(VADM(2),U,1)
- +12 KILL VADM,XRMPRDFN
- +13 QUIT
- +14 ;
- CHG ;change patient
- +1 DO FULL^VALM1
- +2 SET XRMPRDFN=RMPRDFN
- +3 DO GETPAT^RMPRUTIL
- +4 IF '$DATA(RMPRDFN)
- SET RMPRDFN=XRMPRDFN
- +5 DO INIT^RMPREO
- +6 SET VALMBCK="R"
- +7 QUIT
- CANCEL ;cancel suspense
- +1 DO FULL^VALM1
- +2 DO NUM^RMPREOU
- +3 SET RMPREOY=Y
- +4 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO CANCEL^RMPREOS
- +5 KILL RMPREOY,XDA,DA,DUOUT
- +6 DO INIT^RMPREO
- +7 SET VALMBCK="R"
- +8 QUIT
- VIEW ;view consult request
- +1 NEW YY,DA,FLDS,DIC
- +2 DO FULL^VALM1
- +3 DO NUM^RMPREOU
- +4 IF Y=""
- SET VALMBCK="R"
- +5 ;
- +6 SET RN=1
- SET XDA=""
- +7 SET RMPREOY=Y
- +8 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- DO VIEWP
- +9 KILL RMPREOY,DUOUT
- +10 SET VALMBCK="R"
- +11 QUIT
- VIEWP ;
- +1 ;
- +2 if '$DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- QUIT
- +3 SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- +4 SET L=0
- +5 SET DIC="^RMPR(668,"
- SET FLDS="[RMPR VIEW REQUEST]"
- +6 SET BY="@NUMBER"
- SET (FR,TO)=DA
- +7 ;prompt for device
- +8 ;S IOP="HOME"
- +9 DO EN1^DIP
- +10 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- +11 WRITE @IOF
- +12 SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- +13 DO VALL^RMPREO24(DA,.L)
- if L="^"
- QUIT
- +14 QUIT
- +15 ;
- PDISP ;print consultaton sheet
- +1 DO NUM^RMPREOU
- +2 DO FULL^VALM1
- +3 SET RMPREOY=Y
- +4 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO PDISPA
- +5 KILL RMPREOY,XDA,DA,DUOUT
- +6 DO INIT^RMPREO
- +7 SET VALMBCK="R"
- +8 QUIT
- PDISPA ;call consult api
- +1 ;pass DA ien to 668
- +2 DO ENP^RMPREPDT
- +3 QUIT
- DDISP ;detail display
- +1 DO NUM^RMPREOU
- +2 DO FULL^VALM1
- +3 SET RMPREOY=Y
- +4 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO DDISPA
- +5 KILL RMPREOY,XDA,DA,DUOUT
- +6 DO INIT^RMPREO
- +7 SET VALMBCK="R"
- +8 QUIT
- DDISPA ;call list template from listmanager
- +1 ;pass DA ien to file 668
- +2 DO EN^RMPREPDT
- +3 QUIT
- VIEWIA ;view initial action note
- +1 NEW YY,DIC,BY,FLDS,FR,TO,DA
- +2 DO NUM^RMPREOU
- +3 DO FULL^VALM1
- +4 ;
- +5 SET RMPREOY=Y
- +6 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO VIEWIAP
- +7 KILL RMPREOY,XDA,DA,DUOUT
- +8 SET VALMBCK="R"
- +9 QUIT
- VIEWIAP ;loop
- +1 SET L=0
- +2 SET DIC="^RMPR(668,"
- SET FLDS="[RMPR VIEW INITIAL ACTION]"
- +3 SET BY="@NUMBER"
- SET (FR,TO)=DA
- +4 SET IOP="HOME"
- +5 WRITE @IOF
- +6 DO EN1^DIP
- +7 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- +8 QUIT
- +9 ;
- VIEWC ;view complete note
- +1 ;
- +2 NEW YY,DIC,BY,FLDS,FR,TO,DA
- +3 DO NUM^RMPREOU
- +4 DO FULL^VALM1
- +5 ;
- +6 SET RMPREOY=Y
- +7 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO VIEWCP
- +8 KILL RMPREOY,XDA,DA,DUOUT
- +9 SET VALMBCK="R"
- +10 QUIT
- VIEWCP ;loop
- +1 SET L=0
- +2 SET DIC="^RMPR(668,"
- SET FLDS="[RMPR VIEW COMP NOTE]"
- +3 SET BY="@NUMBER"
- SET (FR,TO)=DA
- +4 ;should we ask device?
- +5 ;S IOP="HOME"
- +6 WRITE @IOF
- +7 DO EN1^DIP
- +8 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- +9 QUIT
- +10 ;
- +11 ;
- VIEWO ;view other action notes
- +1 NEW YY,DIC,BY,FLDS,FR,TO,DA
- +2 DO NUM^RMPREOU
- +3 DO FULL^VALM1
- +4 SET RMPREOY=Y
- +5 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO VIEWOP
- +6 KILL RMPREOY,XDA,DA,DUOUT
- +7 SET VALMBCK="R"
- +8 QUIT
- VIEWOP ;loop
- +1 SET L=0
- +2 SET DIC="^RMPR(668,"
- SET FLDS="[RMPR OACT NOTE]"
- +3 SET BY="@NUMBER"
- SET (FR,TO)=DA
- +4 SET IOP="HOME"
- +5 WRITE @IOF
- +6 DO EN1^DIP
- +7 NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- +8 SET VALMBCK="R"
- +9 QUIT
- +10 ;
- IACT ;take initial action
- +1 ;
- +2 NEW YY,DIC,BY,FLDS,FR,TO,DA
- +3 DO NUM^RMPREOU
- +4 DO FULL^VALM1
- +5 SET RMPREOY=Y
- +6 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO ENIA^RMPREOS
- +7 KILL RMPREOY,XDA,DA,DUOUT
- +8 IF $GET(RMSUCLFG)
- DO INIT^RMPREOL
- +9 IF '$GET(RMSUCLFG)
- DO INIT^RMPREO
- +10 SET VALMBCK="R"
- +11 QUIT
- +12 ;
- OACT ;other notes
- +1 NEW YY,DIC,BY,FLDS,FR,TO,DA
- +2 DO NUM^RMPREOU
- +3 DO FULL^VALM1
- +4 SET RMPREOY=Y
- +5 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO OACT^RMPREOS
- +6 KILL RMPREOY,XDA,DA,DUOUT
- +7 IF $GET(RMSUCLFG)
- DO INIT^RMPREOL
- +8 IF '$GET(RMSUCLFG)
- DO INIT^RMPREO
- +9 SET VALMBCK="R"
- +10 QUIT
- +11 ;
- CACT ;complete note
- +1 NEW YY,DIC,BY,FLDS,FR,TO,DA
- +2 DO NUM^RMPREOU
- +3 DO FULL^VALM1
- +4 SET RMPREOY=Y
- +5 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO CLNT^RMPREOS
- +6 KILL RMPREOY,XDA,DA,DUOUT
- +7 IF $GET(RMSUCLFG)
- DO INIT^RMPREOL
- +8 IF '$GET(RMSUCLFG)
- DO INIT^RMPREO
- +9 SET VALMBCK="R"
- +10 QUIT
- +11 ;
- FORW ;forward consult
- +1 NEW YY,DIC,BY,FLDS,FR,TO,DA
- +2 DO NUM^RMPREOU
- +3 DO FULL^VALM1
- +4 SET RMPREOY=Y
- +5 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO FORW^RMPREOS
- +6 KILL RMPREOY,XDA,DA,DUOUT
- +7 DO INIT^RMPREO
- +8 SET VALMBCK="R"
- +9 QUIT
- AMAN ;add manual suspense
- +1 DO FULL^VALM1
- +2 DO EN^RMPREOS
- +3 DO INIT^RMPREO
- +4 SET VALMBCK="R"
- +5 QUIT
- +6 ;
- AAUTO ;add AUTO ADAPTIVE suspense
- +1 DO FULL^VALM1
- +2 DO EN^RMPREOSA
- +3 DO INIT^RMPREO
- +4 SET VALMBCK="R"
- +5 QUIT
- +6 ;
- ACLO ;add CLOTHING ALLOWANCE suspense
- +1 DO FULL^VALM1
- +2 DO EN1^RMPREOSA
- +3 DO INIT^RMPREO
- +4 SET VALMBCK="R"
- +5 QUIT
- +6 ;
- CLONE ;Create Clone CPRS Suspense
- +1 ;new vars here
- +2 DO NUM^RMPREOU
- +3 DO FULL^VALM1
- +4 SET RMPREOY=Y
- +5 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO CLONEP
- +6 KILL RMPREOY,XDA,DA,DUOUT
- +7 DO INIT^RMPREO
- +8 SET VALMBCK="R"
- +9 QUIT
- +10 ;
- CLONEP ;Create Clone CPRS from loop
- +1 DO EN2^RMPREOSA
- +2 QUIT
- +3 ;
- EMAN ;edit manual suspense
- +1 DO FULL^VALM1
- +2 DO NUM^RMPREOU
- +3 SET RMPREOY=Y
- +4 SET RN=""
- +5 FOR RN=1:1
- SET XDA=$PIECE(RMPREOY,",",RN)
- if XDA=""
- QUIT
- if $GET(DUOUT)=1
- QUIT
- IF $DATA(^TMP($JOB,"RMPREOEE",XDA,0))
- SET DA=^TMP($JOB,"RMPREOEE",XDA,0)
- DO EMANP
- +6 KILL RMPREOY,XDA,DA,DUOUT,RN
- +7 QUIT
- EMANP ;edit manual supsense loop
- +1 DO EN2^RMPREOS
- +2 DO INIT^RMPREO
- +3 SET VALMBCK="R"
- +4 QUIT
- +5 ;
- +6 ;END
