RMPR29T ;PHX/JLT-PROCESSING 2529-3 ACTION ;01/04/95 3:56 PM
;;3.0;PROSTHETICS;**78,75**;Feb 09, 1996;Build 25
;
;RMS 08/25/03 Patch #78 - Add shipment date for
;Billing Awareness project
;SPS 06/06/06 Patch #75 - Removed shipment date
;
ASK ;ASK TYPE OF PROCESSING ACTION
;CALLED BY RMPR29T
;VARIABLES REQUIRED: RMPRDA - ENTRY IN FILE 664.1
; RMPR ARRAY - AN ARRAY SET UP BY CALL TO
; DIV4^RMPRSIT
;
I $Y<17 F W ! Q:$Y>17
W !,RMPR("L") K DIR S DIR("A")="Select Processing Action",DIR("A")=$S($D(HLD):DIR("A")_" or press 'return' to view more items: ",1:DIR("A")_": ") G:$D(PSM) AMP G:$D(PASS) ASP G:$D(PAC) ACK G:$D(PNK) ANK
S DIR(0)="SAO^1:EDIT 2529-3 ITEM;2:PROCESS JOB SECTION ;3:INITIATE PROCUREMENT;4:PRINT 2529-3 ;5:RE-DISPLAY SCREEN ;6:CANCEL 2529-3",DIR("?")="^D HELP^RMPR29W W !,$C(7),?5,""Enter a number 1-6""" D HELP^RMPR29W
D ^DIR I (X=""&$D(HLD)) S PAGE=PAGE+1 D HD^RMPR29W G:$D(^UTILITY($J,"W"))!$O(^UTILITY("DIQ1",$J,664.16,+RI,7,0)) EXT^RMPR29D G ITD^RMPR29D
G:$D(DTOUT) END^RMPR29A G:+Y=1 ITM^RMPR29A G:+Y=2 ^RMPR29B G:+Y=3 ^RMPR29P G:+Y=5 DISP^RMPR29D G:+Y=6 CA^RMPR29C
I +Y=4 D PRT^RMPR29R G DISP^RMPR29D
I $D(^XUSEC("RMPR LAB SUPERVISOR",DUZ)) G COM
K DIR S DIR(0)="Y",DIR("A")="Ready for Supervisor Inspection",DIR("B")="NO" D ^DIR I +Y=1 W !!,?5,$C(7),"Request Ready Inspection" S DIE="^RMPR(664.1,",DA=RMPRDA,DR="16///^S X=""PC""" D ^DIE
;I +Y=0 G END^RMPR29A
G END^RMPR29A
; D ^RMPR4E23 ADDED BY RMS
ASP ;ASK TYPE OF ASSIGNMENT ACTION
S DIR(0)="SAO^1:EDIT 2529-3 ITEM;2:ASSIGN 2529-3 TO TECH;3:CANCEL 2529-3;4:PRINT 2529-3",DIR("?")="^D HELP^RMPR29W" D HELP^RMPR29W
D ^DIR I (X=""&$D(HLD)) S PAGE=PAGE+1 D HD^RMPR29W G:$D(^UTILITY($J,"W"))!$O(^UTILITY("DIQ1",$J,664.16,+RI,7,0)) EXT^RMPR29D G ITD^RMPR29D
G:$D(DTOUT) EXIT^RMPR29S G:+Y=1 ITM^RMPR29A G:+Y=2 ATCH^RMPR29S G:+Y=3 CA^RMPR29C
I +Y=4 D PRT^RMPR29R G DISP^RMPR29D
G EXIT^RMPR29S
ACK ;ASK TYPE OF COMPLETION ACTION
S DIR(0)="SAO^1:EDIT 2529-3 ITEM ;2:COMPLETE JOB SECTION;3:RETURN 2529-3 TO LAB;4:PRINT 2529-3 ;5:RE-DISPLAY SCREEN ;6:CANCEL 2529-3",DIR("?")="^D HELP^RMPR29W W !,$C(7),?5,""Enter a Number 1-6""" D HELP^RMPR29W
D ^DIR I (X=""&$D(HLD)) S PAGE=PAGE+1 D HD^RMPR29W G:$D(^UTILITY($J,"W"))!($O(^UTILITY("DIQ1",$J,664.16,+RI,7,0))) EXT^RMPR29D G ITD^RMPR29D
G:$D(DTOUT) END^RMPR29A G:+Y=1 ITM^RMPR29A G:+Y=2 ^RMPR29B G:+Y=3 RT^RMPR29C G:+Y=5 DISP^RMPR29D G:+Y=6 CA^RMPR29C
I +Y=4 D PRT^RMPR29R G DISP^RMPR29D
COM ;COMPLETE 2529-3
K DIR S DIR(0)="Y",DIR("A")="Complete and Post 2529-3",DIR("B")="NO" D ^DIR I +Y=0 G END^RMPR29A
D CHK I $D(RFL) G END^RMPR29A
K DA,Y,DIC,X S DA=RMPRDA,DR="24",DIE="^RMPR(664.1," D ^DIE I $D(DTOUT)!($D(Y)) D MESS G END^RMPR29A
I $P(^RMPR(664.1,RMPRDA,0),U,27)=3 W !!,$C(7),?5,"2529-3 cannot be completed until issued to Veteran" G END^RMPR29A
S DA=RMPRDA,DR="33;20R",DIE="^RMPR(664.1," D ^DIE I $D(DTOUT)!($D(Y)) D MESS G END^RMPR29A
S:'$P(^RMPR(664.1,RMPRDA,0),U,25) $P(^RMPR(664.1,RMPRDA,0),U,25)=DUZ S $P(^RMPR(664.1,RMPRDA,0),U,26)=DT
W !!,?5,$C(7),"Request Completed and Posted!!!" S DIE="^RMPR(664.1,",DR="16///^S X=""C""",DA=RMPRDA D ^DIE
G END^RMPR29A
ANK ;ASK TYPE OF CLOSE OUT ACTION
S DIR(0)="SAO^1:EDIT 2529-3 ITEM ;2:PRINT 2529-3 ;3:RE-DISPLAY SCREEN ;4:CANCEL 2529-3 ;5:CLOSE OUT A 2529-3",DIR("?")="^D HELP^RMPR29W W !,$C(7),?5,""Enter a Number 1-5""" D HELP^RMPR29W
D ^DIR I (X=""&$D(HLD)) S PAGE=PAGE+1 D HDC^RMPR29W G:$D(^UTILITY($J,"W"))!($O(^UTILITY("DIQ1",$J,664.16,+RI,7,0))) EXT^RMPR29D G ITD^RMPR29D
G:+Y=1 ITM^RMPR29A G:+Y=3 DISP^RMPR29D G:+Y=4 CA^RMPR29C
I +Y=2 D PRT^RMPR29R G DISP^RMPR29D
;K DIR S DIR(0)="Y",DIR("A")="Close out 2529-3",DIR("B")="NO" D ^DIR I +Y=0 D MESS G EXIT^RMPR29C
I +Y=5 D G EXIT^RMPR29C
.K DA,Y,DIC,X
.S DA=RMPRDA,DIE="^RMPR(664.1,",DR="4;33;20R"
.D ^DIE
.I $D(DTOUT)!$D(Y) D MESS Q
.W !!,?5,$C(7),"Request Closed out and Posted!!!"
.I $P(^RMPR(664.1,RMPRDA,0),U,20),$P(^(0),U,23) D DEL^RMPR29P(RMPRDA),PST^RMPR29P(RMPRDA)
.N RMPRDL S RMPRDL=$P($G(^RMPR(664.1,RMPRDA,7)),U,2)
.F RI=0:0 S RI=$O(^RMPR(664.1,RMPRDA,2,RI)) Q:RI'>0 I $D(^(RI,0)) S DA=$P(^(0),U,5) I +DA>0,RMPRDL S DIE="^RMPR(660,",DR="10///@;10///^S X=RMPRDL" D ^DIE
.S:'$P(^RMPR(664.1,RMPRDA,0),U,25) $P(^RMPR(664.1,RMPRDA,0),U,25)=DUZ S $P(^RMPR(664.1,RMPRDA,0),U,26)=DT
.S DIE="^RMPR(664.1,",DA=RMPRDA,DR="16///^S X=""C""" D ^DIE
Q
CHK ;CHK TO SEE IF JOB SECTION IS COMPLETE
K RFL F RI=0:0 S RI=$O(^RMPR(664.1,RMPRDA,2,RI)) Q:RI'>0 I $D(^(RI,0)) S RDA=^(0),RA=$P(RDA,U,5) D
.;see internal notes
.S (RZP,DA)=$O(^RMPR(664.2,"C",RA,0))
.S RMPRCD=$P($G(^RMPR(664.2,+DA,0)),U,10) I 'RMPRCD S RFL=1 W !!,$C(7),"Date Completed has not been entered for JOB "
I $D(RFL) W !!,$C(7),?5,"2529-3 Job Section is Incomplete!!"
Q
AMP ;ASK TYPE OF MULTIPLE ASSIGMENT ACTION
S DIR(0)="SAO^1:EDIT 2529-3 ITEM;2:ASSIGN 2529-3 TO TECH;3:CANCEL 2529-3;4:PRINT 2529-3 ;5:NEXT ENTRY ;6:PREVIOUS ENTRY",DIR("?")="^D HELP^RMPR29W" D HELP^RMPR29W
D ^DIR I (X=""&$D(HLD)) S PAGE=PAGE+1 D HD^RMPR29W G:$D(^UTILITY($J,"W"))!$O(^UTILITY("DIQ1",$J,664.16,+RI,7,0)) EXT^RMPR29D G ITD^RMPR29D
G:$D(DTOUT) EXIT^RMPR29S G:+Y=1 ITM^RMPR29A G:+Y=2 ATCH^RMPR29S G:+Y=3 CA^RMPR29C G:+Y=5 NEXT^RMPR29S G:+Y=6 PREV^RMPR29S
I +Y=4 D PRT^RMPR29R G DISP^RMPR29D
G EXIT^RMPR29S
MESS ;MESSAGE IF DTOUT OR $D(Y)
W !!,$C(7),?5,"2529-3 has not been completed!!" Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPR29T 5514 printed Dec 13, 2024@02:32:28 Page 2
RMPR29T ;PHX/JLT-PROCESSING 2529-3 ACTION ;01/04/95 3:56 PM
+1 ;;3.0;PROSTHETICS;**78,75**;Feb 09, 1996;Build 25
+2 ;
+3 ;RMS 08/25/03 Patch #78 - Add shipment date for
+4 ;Billing Awareness project
+5 ;SPS 06/06/06 Patch #75 - Removed shipment date
+6 ;
ASK ;ASK TYPE OF PROCESSING ACTION
+1 ;CALLED BY RMPR29T
+2 ;VARIABLES REQUIRED: RMPRDA - ENTRY IN FILE 664.1
+3 ; RMPR ARRAY - AN ARRAY SET UP BY CALL TO
+4 ; DIV4^RMPRSIT
+5 ;
+6 IF $Y<17
FOR
WRITE !
if $Y>17
QUIT
+7 WRITE !,RMPR("L")
KILL DIR
SET DIR("A")="Select Processing Action"
SET DIR("A")=$SELECT($DATA(HLD):DIR("A")_" or press 'return' to view more items: ",1:DIR("A")_": ")
if $DATA(PSM)
GOTO AMP
if $DATA(PASS)
GOTO ASP
if $DATA(PAC)
GOTO ACK
if $DATA(PNK)
GOTO ANK
+8 SET DIR(0)="SAO^1:EDIT 2529-3 ITEM;2:PROCESS JOB SECTION ;3:INITIATE PROCUREMENT;4:PRINT 2529-3 ;5:RE-DISPLAY SCREEN ;6:CANCEL 2529-3"
SET DIR("?")="^D HELP^RMPR29W W !,$C(7),?5,""Enter a number 1-6"""
DO HELP^RMPR29W
+9 DO ^DIR
IF (X=""&$DATA(HLD))
SET PAGE=PAGE+1
DO HD^RMPR29W
if $DATA(^UTILITY($JOB,"W"))!$ORDER(^UTILITY("DIQ1",$JOB,664.16,+RI,7,0))
GOTO EXT^RMPR29D
GOTO ITD^RMPR29D
+10 if $DATA(DTOUT)
GOTO END^RMPR29A
if +Y=1
GOTO ITM^RMPR29A
if +Y=2
GOTO ^RMPR29B
if +Y=3
GOTO ^RMPR29P
if +Y=5
GOTO DISP^RMPR29D
if +Y=6
GOTO CA^RMPR29C
+11 IF +Y=4
DO PRT^RMPR29R
GOTO DISP^RMPR29D
+12 IF $DATA(^XUSEC("RMPR LAB SUPERVISOR",DUZ))
GOTO COM
+13 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Ready for Supervisor Inspection"
SET DIR("B")="NO"
DO ^DIR
IF +Y=1
WRITE !!,?5,$CHAR(7),"Request Ready Inspection"
SET DIE="^RMPR(664.1,"
SET DA=RMPRDA
SET DR="16///^S X=""PC"""
DO ^DIE
+14 ;I +Y=0 G END^RMPR29A
+15 GOTO END^RMPR29A
+16 ; D ^RMPR4E23 ADDED BY RMS
ASP ;ASK TYPE OF ASSIGNMENT ACTION
+1 SET DIR(0)="SAO^1:EDIT 2529-3 ITEM;2:ASSIGN 2529-3 TO TECH;3:CANCEL 2529-3;4:PRINT 2529-3"
SET DIR("?")="^D HELP^RMPR29W"
DO HELP^RMPR29W
+2 DO ^DIR
IF (X=""&$DATA(HLD))
SET PAGE=PAGE+1
DO HD^RMPR29W
if $DATA(^UTILITY($JOB,"W"))!$ORDER(^UTILITY("DIQ1",$JOB,664.16,+RI,7,0))
GOTO EXT^RMPR29D
GOTO ITD^RMPR29D
+3 if $DATA(DTOUT)
GOTO EXIT^RMPR29S
if +Y=1
GOTO ITM^RMPR29A
if +Y=2
GOTO ATCH^RMPR29S
if +Y=3
GOTO CA^RMPR29C
+4 IF +Y=4
DO PRT^RMPR29R
GOTO DISP^RMPR29D
+5 GOTO EXIT^RMPR29S
ACK ;ASK TYPE OF COMPLETION ACTION
+1 SET DIR(0)="SAO^1:EDIT 2529-3 ITEM ;2:COMPLETE JOB SECTION;3:RETURN 2529-3 TO LAB;4:PRINT 2529-3 ;5:RE-DISPLAY SCREEN ;6:CANCEL 2529-3"
SET DIR("?")="^D HELP^RMPR29W W !,$C(7),?5,""Enter a Number 1-6"""
DO HELP^RMPR29W
+2 DO ^DIR
IF (X=""&$DATA(HLD))
SET PAGE=PAGE+1
DO HD^RMPR29W
if $DATA(^UTILITY($JOB,"W"))!($ORDER(^UTILITY("DIQ1",$JOB,664.16,+RI,7,0)))
GOTO EXT^RMPR29D
GOTO ITD^RMPR29D
+3 if $DATA(DTOUT)
GOTO END^RMPR29A
if +Y=1
GOTO ITM^RMPR29A
if +Y=2
GOTO ^RMPR29B
if +Y=3
GOTO RT^RMPR29C
if +Y=5
GOTO DISP^RMPR29D
if +Y=6
GOTO CA^RMPR29C
+4 IF +Y=4
DO PRT^RMPR29R
GOTO DISP^RMPR29D
COM ;COMPLETE 2529-3
+1 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Complete and Post 2529-3"
SET DIR("B")="NO"
DO ^DIR
IF +Y=0
GOTO END^RMPR29A
+2 DO CHK
IF $DATA(RFL)
GOTO END^RMPR29A
+3 KILL DA,Y,DIC,X
SET DA=RMPRDA
SET DR="24"
SET DIE="^RMPR(664.1,"
DO ^DIE
IF $DATA(DTOUT)!($DATA(Y))
DO MESS
GOTO END^RMPR29A
+4 IF $PIECE(^RMPR(664.1,RMPRDA,0),U,27)=3
WRITE !!,$CHAR(7),?5,"2529-3 cannot be completed until issued to Veteran"
GOTO END^RMPR29A
+5 SET DA=RMPRDA
SET DR="33;20R"
SET DIE="^RMPR(664.1,"
DO ^DIE
IF $DATA(DTOUT)!($DATA(Y))
DO MESS
GOTO END^RMPR29A
+6 if '$PIECE(^RMPR(664.1,RMPRDA,0),U,25)
SET $PIECE(^RMPR(664.1,RMPRDA,0),U,25)=DUZ
SET $PIECE(^RMPR(664.1,RMPRDA,0),U,26)=DT
+7 WRITE !!,?5,$CHAR(7),"Request Completed and Posted!!!"
SET DIE="^RMPR(664.1,"
SET DR="16///^S X=""C"""
SET DA=RMPRDA
DO ^DIE
+8 GOTO END^RMPR29A
ANK ;ASK TYPE OF CLOSE OUT ACTION
+1 SET DIR(0)="SAO^1:EDIT 2529-3 ITEM ;2:PRINT 2529-3 ;3:RE-DISPLAY SCREEN ;4:CANCEL 2529-3 ;5:CLOSE OUT A 2529-3"
SET DIR("?")="^D HELP^RMPR29W W !,$C(7),?5,""Enter a Number 1-5"""
DO HELP^RMPR29W
+2 DO ^DIR
IF (X=""&$DATA(HLD))
SET PAGE=PAGE+1
DO HDC^RMPR29W
if $DATA(^UTILITY($JOB,"W"))!($ORDER(^UTILITY("DIQ1",$JOB,664.16,+RI,7,0)))
GOTO EXT^RMPR29D
GOTO ITD^RMPR29D
+3 if +Y=1
GOTO ITM^RMPR29A
if +Y=3
GOTO DISP^RMPR29D
if +Y=4
GOTO CA^RMPR29C
+4 IF +Y=2
DO PRT^RMPR29R
GOTO DISP^RMPR29D
+5 ;K DIR S DIR(0)="Y",DIR("A")="Close out 2529-3",DIR("B")="NO" D ^DIR I +Y=0 D MESS G EXIT^RMPR29C
+6 IF +Y=5
Begin DoDot:1
+7 KILL DA,Y,DIC,X
+8 SET DA=RMPRDA
SET DIE="^RMPR(664.1,"
SET DR="4;33;20R"
+9 DO ^DIE
+10 IF $DATA(DTOUT)!$DATA(Y)
DO MESS
QUIT
+11 WRITE !!,?5,$CHAR(7),"Request Closed out and Posted!!!"
+12 IF $PIECE(^RMPR(664.1,RMPRDA,0),U,20)
IF $PIECE(^(0),U,23)
DO DEL^RMPR29P(RMPRDA)
DO PST^RMPR29P(RMPRDA)
+13 NEW RMPRDL
SET RMPRDL=$PIECE($GET(^RMPR(664.1,RMPRDA,7)),U,2)
+14 FOR RI=0:0
SET RI=$ORDER(^RMPR(664.1,RMPRDA,2,RI))
if RI'>0
QUIT
IF $DATA(^(RI,0))
SET DA=$PIECE(^(0),U,5)
IF +DA>0
IF RMPRDL
SET DIE="^RMPR(660,"
SET DR="10///@;10///^S X=RMPRDL"
DO ^DIE
+15 if '$PIECE(^RMPR(664.1,RMPRDA,0),U,25)
SET $PIECE(^RMPR(664.1,RMPRDA,0),U,25)=DUZ
SET $PIECE(^RMPR(664.1,RMPRDA,0),U,26)=DT
+16 SET DIE="^RMPR(664.1,"
SET DA=RMPRDA
SET DR="16///^S X=""C"""
DO ^DIE
End DoDot:1
GOTO EXIT^RMPR29C
+17 QUIT
CHK ;CHK TO SEE IF JOB SECTION IS COMPLETE
+1 KILL RFL
FOR RI=0:0
SET RI=$ORDER(^RMPR(664.1,RMPRDA,2,RI))
if RI'>0
QUIT
IF $DATA(^(RI,0))
SET RDA=^(0)
SET RA=$PIECE(RDA,U,5)
Begin DoDot:1
+2 ;see internal notes
+3 SET (RZP,DA)=$ORDER(^RMPR(664.2,"C",RA,0))
+4 SET RMPRCD=$PIECE($GET(^RMPR(664.2,+DA,0)),U,10)
IF 'RMPRCD
SET RFL=1
WRITE !!,$CHAR(7),"Date Completed has not been entered for JOB "
End DoDot:1
+5 IF $DATA(RFL)
WRITE !!,$CHAR(7),?5,"2529-3 Job Section is Incomplete!!"
+6 QUIT
AMP ;ASK TYPE OF MULTIPLE ASSIGMENT ACTION
+1 SET DIR(0)="SAO^1:EDIT 2529-3 ITEM;2:ASSIGN 2529-3 TO TECH;3:CANCEL 2529-3;4:PRINT 2529-3 ;5:NEXT ENTRY ;6:PREVIOUS ENTRY"
SET DIR("?")="^D HELP^RMPR29W"
DO HELP^RMPR29W
+2 DO ^DIR
IF (X=""&$DATA(HLD))
SET PAGE=PAGE+1
DO HD^RMPR29W
if $DATA(^UTILITY($JOB,"W"))!$ORDER(^UTILITY("DIQ1",$JOB,664.16,+RI,7,0))
GOTO EXT^RMPR29D
GOTO ITD^RMPR29D
+3 if $DATA(DTOUT)
GOTO EXIT^RMPR29S
if +Y=1
GOTO ITM^RMPR29A
if +Y=2
GOTO ATCH^RMPR29S
if +Y=3
GOTO CA^RMPR29C
if +Y=5
GOTO NEXT^RMPR29S
if +Y=6
GOTO PREV^RMPR29S
+4 IF +Y=4
DO PRT^RMPR29R
GOTO DISP^RMPR29D
+5 GOTO EXIT^RMPR29S
MESS ;MESSAGE IF DTOUT OR $D(Y)
+1 WRITE !!,$CHAR(7),?5,"2529-3 has not been completed!!"
QUIT
+2 QUIT
