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