79 lines
5.3 KiB
Mathematica
79 lines
5.3 KiB
Mathematica
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
|