[613] | 1 | PRCNUTL ;SSI/ALA-UTILITY PROGRAM ;[ 09/11/96 2:08 PM ]
|
---|
| 2 | ;;1.0;Equipment/Turn-In Request;**15**;Sep 13, 1996
|
---|
| 3 | SEQ ; Get the next sequential number, returns PRCNDA and TST
|
---|
| 4 | ; TST is the beginning part of the transaction number
|
---|
| 5 | S NDA=$O(^PRCN(413.7,"B",TST,"")) I NDA="" D
|
---|
| 6 | . NEW DIC,DIE,DA,DR,DLAYGO
|
---|
| 7 | . S X=TST,DIC="^PRCN(413.7,",DIC(0)="L",DLAYGO=413.7 D FILE^DICN
|
---|
| 8 | . S NDA=+Y,$P(^PRCN(413.7,NDA,0),U,2)=0
|
---|
| 9 | S PRCNDA=$P(^PRCN(413.7,NDA,0),U,2)+1,$P(^PRCN(413.7,NDA,0),U,2)=PRCNDA
|
---|
| 10 | EXIT K NDA,X,Y Q
|
---|
| 11 | EMSG ; Loop for message for requests
|
---|
| 12 | S (X,CT)=0 F S X=$O(^PRCN(413,"AC",STA,X)) Q:X="" D
|
---|
| 13 | . I STA=1,$P(^PRCN(413,X,0),U,2)'=DUZ Q
|
---|
| 14 | . I STA=3,$P(^PRCN(413,X,0),U,6)'=DUZ Q
|
---|
| 15 | . I STA=9,$G(^PRCN(413,X,5,"B",DUZ))="" Q
|
---|
| 16 | . I STA=45,$P(^PRCN(413,X,0),U,6)'=DUZ Q
|
---|
| 17 | . S CT=CT+1
|
---|
| 18 | I CT>0 W $C(7),!!! D
|
---|
| 19 | . S TEX3=$P(^PRCN(413.5,STA,0),U),TEX1=$S(CT=1:"is",1:"are")
|
---|
| 20 | . S TEX2=$S(CT=1:"request",1:"requests")
|
---|
| 21 | . W !,?3,"There "_TEX1_" "_CT_" equipment "_TEX2_" "_TEX3_"."
|
---|
| 22 | K X,CT,TEX1,TEX2,TEX3
|
---|
| 23 | Q
|
---|
| 24 | TMSG ; Loop for turn-in messages
|
---|
| 25 | S (X,CT)=0 F S X=$O(^PRCN(413.1,"AC",STA,X)) Q:X="" D
|
---|
| 26 | . I STA=1,$P(^PRCN(413.1,X,0),U,2)'=DUZ Q
|
---|
| 27 | . I STA=3,$P(^PRCN(413.1,X,0),U,6)'=DUZ Q
|
---|
| 28 | . S CT=CT+1
|
---|
| 29 | I CT>0 W $C(7),!!! D
|
---|
| 30 | . S TEX1=$S(CT=1:"is",1:"are"),TEX2=$S(CT=1:"request",1:"requests")
|
---|
| 31 | . S TEX3=$P(^PRCN(413.5,STA,0),U)
|
---|
| 32 | . W ?3,"There "_TEX1_" "_CT_" Turn-In "_TEX2_" "_TEX3
|
---|
| 33 | K X,CT Q
|
---|
| 34 | ; Electronic Signature Code check. FAIL is defined if check fails.
|
---|
| 35 | ES S FAIL="" D ESIG^PRCUESIG(DUZ,.FAIL)
|
---|
| 36 | ES1 I FAIL<1 W $C(7)," SIGNATURE CODE FAILURE " R X:3 G EQ
|
---|
| 37 | EQ K X,I Q
|
---|
| 38 | FYQ ;RETURNS FY AND QTR GIVEN IN FILEMANAGER DATE IN 'X'
|
---|
| 39 | G:'$D(X) QQ G:X=""!($E(X,1,7)'?7N)!(+$E(X,1,7)'=$E(X,1,7)) QQ
|
---|
| 40 | S Y=$E(X,2,3),Y(1)=$E(X,4,5),PRC("FY")=$S(Y(1)<10:Y,1:Y+1)
|
---|
| 41 | S PRC("QTR")=$S(Y(1)<4:2,Y(1)<7:3,Y(1)<10:4,1:1) K Y S %=1 Q
|
---|
| 42 | QQ K PRC,PRCF("X"),PRCB,%DT,DIC,%F,A,B,X,Y S %=0 Q
|
---|
| 43 | EN1 ; Check for utilities=13 to ask for free text OTHER
|
---|
| 44 | S FL=0 S:$D(^PRCN(413,DA,3,"B",13)) FL=1
|
---|
| 45 | Q
|
---|
| 46 | VEN ; Translate potential vendor field into pointer and store it
|
---|
| 47 | S VEN=X
|
---|
| 48 | N DIEL,DM,DC,DH,DI,DK,DP,DL,DIFLD,DQ,DR,DIC,DIE,DA,X,Y
|
---|
| 49 | S X=VEN,DIC(0)="EZ",DIC="^PRC(440," D ^DIC S PRCNVEN=+Y
|
---|
| 50 | I PRCNVEN<0 S $P(^PRCN(413,D0,1,D1,0),U,13)=VEN,$P(^(0),U,2)="" G EX
|
---|
| 51 | I PRCNVEN'<0 S $P(^PRCN(413,D0,1,D1,0),U,2)=PRCNVEN,$P(^(0),U,13)=""
|
---|
| 52 | EX K VEN,PRCNVEN
|
---|
| 53 | Q
|
---|
| 54 | VENHLP ; Executable help for potential vendor field
|
---|
| 55 | S DUOUT=0,PRCNCT=0,HL0=0
|
---|
| 56 | F S HL0=$O(^DD(413.015,2,21,HL0)) Q:HL0'>0 W !,^DD(413.015,2,21,HL0,0)
|
---|
| 57 | W !!,"Current Vendors: "
|
---|
| 58 | S L="" F S L=$O(^PRC(440,"B",L)) Q:L="" D T I $G(DUOUT)=1 S DUOUT=0 Q
|
---|
| 59 | K L,PRCNDI,PRCND,PRCNA,X
|
---|
| 60 | Q
|
---|
| 61 | T S PRCNCT=PRCNCT+1
|
---|
| 62 | I PRCNCT<10 W !,L Q
|
---|
| 63 | R !,"'^' TO STOP: ",PRCNA:DTIME S:'$T PRCNA=U
|
---|
| 64 | I $G(PRCNA)[U S DUOUT=1 Q
|
---|
| 65 | S PRCNCT=0 Q
|
---|
| 66 | ;
|
---|
| 67 | CHECK ; PRCN*1.0*15 new subroutine to check if all line items for a
|
---|
| 68 | ; transaction have been dispositioned - CMR equals null if dispo'd
|
---|
| 69 | N N1,PRCNT0
|
---|
| 70 | S POP=1
|
---|
| 71 | S N1=999 F S N1=$O(^PRCN(413.1,PRCNTDA,1,N1),-1) Q:'N1 D
|
---|
| 72 | . S PRCNT0=$P($G(^PRCN(413.1,PRCNTDA,1,N1,0)),U)
|
---|
| 73 | . I +$P($G(^ENG(6914,PRCNT0,2)),U,9) S POP=0 Q
|
---|
| 74 | D:'POP DMSG
|
---|
| 75 | Q
|
---|
| 76 | ;
|
---|
| 77 | DMSG ; PRCN*1.0*15 new subroutine to display message to user
|
---|
| 78 | W !! F X=1:1:79 W "*"
|
---|
| 79 | W !,"* SORRY. THERE ARE ADDITIONAL LINE ITEMS FOR TRANSACTION:",?78,"*"
|
---|
| 80 | W !,"*",?78,"*"
|
---|
| 81 | W !,"*",?80-$L($G(Y(0,0)))/2,$G(Y(0,0)),?78,"*"
|
---|
| 82 | W !,"*",?78,"*"
|
---|
| 83 | W !,"* THAT MUST BE DISPOSITIONED BEFORE THIS TRANSACTION CAN BE FINALIZED.",?78,"*"
|
---|
| 84 | W ! F X=1:1:79 W "*"
|
---|
| 85 | W !!
|
---|
| 86 | Q
|
---|
| 87 | ;
|
---|
| 88 | RESET ; PRCN*1.0*15 reset status, plus original CMR and SGL values
|
---|
| 89 | ; and set disposition date, method and value each to null
|
---|
| 90 | N DATA,OLDCMR,OLDSGL,OLDUST,NULL,N
|
---|
| 91 | S DIE="^PRCN(413.1,",DR="6////"_23 D ^DIE
|
---|
| 92 | N DA
|
---|
| 93 | S N=0 F S N=$O(OLDVALUE(N)) Q:'N D
|
---|
| 94 | . S DATA=OLDVALUE(N),NULL=""
|
---|
| 95 | . S DA=$P(DATA,U,1),OLDCMR=$P(DATA,U,2),OLDUST=$P(DATA,U,3),OLDSGL=$P(DATA,U,4)
|
---|
| 96 | . S DIE="^ENG(6914,"
|
---|
| 97 | . S DR="19////^S X=OLDCMR;20////^S X=OLDUST;38////^S X=OLDSGL;22///@;31///@;32///@" D ^DIE
|
---|
| 98 | . K DA,DIE,DR
|
---|
| 99 | Q
|
---|