source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCEDRE1.m@ 810

Last change on this file since 810 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1PRCEDRE1 ;WISC/LDB-EDIT DAILY RECORD ; 07/16/93 9:29 AM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4ED ;Called from PRCEDRE to edit a daily record
5 D SCR,NUM,KILL^%ZISS
6 Q
7SCR S (FR,TO)=$P(DRDA(0),U),BY=.01,FLDS="[PRCE DAILY RECORD EDIT]",DIC="^PRC(424.1,",L=0,IOP="HOME" D EN1^DIP
8 Q
9HLP0 S DY=16,DX=0 X IOXY D CLR S DY=17,DX=0 X IOXY W !!,"Enter number(s) from the left hand side of the screen"
10 W !,"that correspond to the field that you would like to change."
11 W !,"Enter numbers 1-4 in a list like 2,3,4 or a range like 1-3 or"
12 W !,"one number at a time."
13 W !,"ONLY NUMBERED PROMPTS can be edited."
14 S DY=16,DX=0 X IOXY
15 Q
16HLP1 S DY=16,DX=0 X IOXY D CLR S DY=19,DX=0 X IOXY W HLPMSG S DY=16,DX=0 X IOXY Q
17HLP ;HELP MESSAGES
18 ;;Enter an amount between 0 and 999999999.99"
19 ;;Enter vendor number
20 ;;Enter the reference for this record 3-15 characters
21 ;;Enter any comments or description for this record -245 characters or less
22NUM D ENS^%ZISS
23 S DY=16,DX=0 X IOXY S DIR("A")="WHICH NUMBER(S) WOULD YOU LIKE TO EDIT (1-4): " S DIR(0)="LA^1:4"
24 S DIR("?")="^D HLP0^PRCEDRE1" D ^DIR
25 Q:'Y
26 K PRDERD,DIR F NUM=1:1 Q:$P(Y,",",NUM)="" S PRCERD(NUM)=$P(Y,",",NUM)
27 S (DR,NUM,FLD,FLG)="" F S NUM=$O(PRCERD(NUM)) Q:'NUM D Q:$D(DIRUT)
28 . I PRCERD(NUM)=1,$P(^PRC(424,AUDA,0),U,9) D Q
29 ..S X="This authorization has been marked as complete and NO EDITING of the authorization amount can be done until the authorization is reopened." D MSG^PRCFQ H 3
30 . K DIR S DIR(0)="424.1,"_$S(PRCERD(NUM)=1:.03,PRCERD(NUM)=2:.06,PRCERD(NUM)=3:.08,1:1.1)_"O"
31 . S DIR("?")="^D HLP1^PRCEDRE1",HLPMSG=$P($T(HLP+$S(PRCERD(NUM)=1:1,PRCERD(NUM)=2:2,PRCERD(NUM)=3:3,1:4)),";;",2)
32 . S DY=16,DX=0 X IOXY D CLR S DY=16,DX=0 X IOXY D ^DIR
33 . I DIR(0)[".03" D AMT S Y=$S(PRCADJ:"",AAMT2<0:"",1:-AAMT2) I AAMT2<0 S Y="" W !,"Negative amounts are not valid entries for detailed daily records.",$C(7) Q
34 . I $D(Y),Y']"" K DIRUT Q
35 . Q:$D(DIRUT) S FLD=Y
36 . I PRCERD(NUM)'=4 S (ZDY,DY)=(PRCERD(NUM))+6,DX=24 X IOXY S IOELALL="",$P(IOELALL," ",IOM)="" W IOELALL S DX=24,DY=ZDY X IOXY W IOINHI,$S(PRCERD(NUM)'=1:FLD,1:"$"_$J((FLD/-1),12,2)),IOINLOW
37 . I PRCERD(NUM)=4 F X=1:1:4 S DY=10+X,DX=24 X IOXY W IOELALL
38 . I PRCERD(NUM)=4 S DY=11,DX=24 X IOXY W IOINHI,$E(FLD,1,55),?24,$E(FLD,56,101),!,?24,$E(FLD,102,157),!,?24,$E(FLD,158,213),!,?24,$E(FLD,241,245) W IOINLOW
39 . S DR=$S(PRCERD(NUM)=1:.03,PRCERD(NUM)=2:.06,PRCERD(NUM)=3:.08,1:1.1)_"////^S X=FLD"
40 . S DIE="^PRC(424.1,",DA=DRDA D ^DIE
41 . S DR="",FLG=1
42 Q:'FLG S DA=DRDA,DIE="^PRC(424.1,"
43 D NOW^%DTC S TIME=$E(%,1,12) S DIE="^PRC(424.1,",DR=".04////^S X=TIME;.1////^S X=DUZ" D ^DIE
44 H 3 D SCR W !!,"Press 'RETURN' to continue" R X:DTIME Q
45CLR W IOEDEOP Q
46 ;
47AMT ;Check for completed authorization and amount of change
48 S PRCADJ=0,(AAMT,AAMT2)=X Q:X<0 S AUDA=$P($G(^PRC(424.1,DRDA,0)),U,2),AUDA0=$G(^PRC(424,+AUDA,0)),ABAL=$P(AUDA0,U,5),AAMT1=$P(^PRC(424.1,DRDA,0),U,3)/-1 Q:'AUDA
49 S AAMT=$S((AAMT>AAMT1):AAMT-AAMT1,(AAMT<AAMT1):(AAMT1-AAMT),1:AAMT)
50 S PODA=$P($G(^PRC(424,AUDA,0)),U,2),BAL=$$BAL^PRCH58(PODA) D NOW^%DTC S TIME=% D:BAL BUL^PRCEAU0
51 I AAMT2>AAMT1 S ABAL=$P($G(^PRC(424,AUDA,0)),U,5) D Q
52 . I AAMT>ABAL D AMTOVR^PRCEDRE0 D Q:PRCADJ
53 .. D SCR Q:'PRCADJ
54 .. S Y=""
55 . S $P(^PRC(424,AUDA,0),U,5)=$P(^PRC(424,AUDA,0),U,5)-AAMT
56 I AAMT2<AAMT1 S $P(^PRC(424,AUDA,0),U,5)=ABAL+AAMT Q
57 K:AAMT2=AAMT1 X
58 Q
59 ;
Note: See TracBrowser for help on using the repository browser.