85 lines
4.0 KiB
Mathematica
85 lines
4.0 KiB
Mathematica
PRCPUTRS ;WISC/RFJ-transaction history file selection ;07 Jul 92
|
|
;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
;
|
|
;
|
|
SELECT(PRCPINPT) ; select transaction register entry for inventory point
|
|
N DA,PIECES,PRCPFLAG,X,Y
|
|
D INFOHELP
|
|
;
|
|
F D Q:$G(PRCPFLAG)
|
|
. W !,"Select TRANSACTION REGISTER entry: "
|
|
. R X:DTIME S:'$T X="^" I X["^" S X="^",PRCPFLAG=1 Q
|
|
. I X="" S PRCPFLAG=1 Q
|
|
. I X["?" D HELP(""),INFOHELP Q
|
|
. S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|
. ; lookup by trans id
|
|
. I "RUACSPE"[$E(X),$D(^PRCP(445.2,"T",PRCPINPT,X)) S DA=$$SHOW("^PRCP(445.2,""T"","_PRCPINPT_","""_X_""",") S:DA PRCPFLAG=1 Q
|
|
. I $E($O(^PRCP(445.2,"T",PRCPINPT,X)))=$E(X) D HELP(X),INFOHELP Q
|
|
. ;
|
|
. ; lookup by voucher number
|
|
. I $D(^PRCP(445.2,"V",X)) S DA=$$SHOW("^PRCP(445.2,""V"","""_X_""",") S:DA PRCPFLAG=1 Q
|
|
. ;
|
|
. ; lookup by transaction number
|
|
. S PIECES=$L(X,"-")
|
|
. I $L($P(X,"-",PIECES))=4 D
|
|
. . I PIECES=5 Q
|
|
. . I PIECES=4 S X=PRC("SITE")_"-"_X
|
|
. . I PIECES=3 S X=PRC("SITE")_"-"_PRC("FY")_"-"_X Q
|
|
. . I PIECES=2 S X=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_X
|
|
. I $L(X,"-")=1 S X=PRC("SITE")_"-"_X
|
|
. I $D(^PRCP(445.2,"C",X)) S DA=$$SHOW("^PRCP(445.2,""C"","""_X_""",") S:DA PRCPFLAG=1 Q
|
|
. W ?65,"invalid entry"
|
|
S X=$G(^PRCP(445.2,+$G(DA),0))
|
|
I X'="" S Y=$P(X,"^",3) W !,"selected: ",$P(X,"^",2),?20,$P(X,"^",19),?40,$P(X,"^",15),?50,$E(Y,4,5),"-",$E(Y,6,7),"-",$E(Y,2,3),?60,"IM#",$P(X,"^",5),?70,$E($$DESCR^PRCPUX1(PRCPINPT,+$P(X,"^",5)),1,9)
|
|
Q +$G(DA)
|
|
;
|
|
;
|
|
SHOW(GLOBAL) ; present list of matches to user
|
|
N DA,DATA,ENDLINE,LINE,PRCPFLAG,SELECTDA,STARTLIN,Y
|
|
K ^TMP($J,"PRCPUTRS")
|
|
S LINE=0,DA=0
|
|
F D Q:$G(PRCPFLAG)
|
|
. S STARTLIN=LINE+1 F S DA=$O(@(GLOBAL_DA_")")) Q:'DA I $P($G(^PRCP(445.2,DA,0)),"^")=PRCPINPT S LINE=LINE+1,^TMP($J,"PRCPUTRS",LINE)=DA Q:LINE#15=0
|
|
. I '$D(^TMP($J,"PRCPUTRS",STARTLIN)) S PRCPFLAG=1 Q
|
|
. ; one entry only
|
|
. I LINE=1 S SELECTDA=^TMP($J,"PRCPUTRS",1),PRCPFLAG=1 Q
|
|
. ;
|
|
. W !!?2,"ENTRY",?10,"TRANID",?20,"TRANSACTION",?40,"VOUCHER",?50,"DATE",?60,"ITEM"
|
|
. F ENDLINE=STARTLIN:1 Q:'$D(^TMP($J,"PRCPUTRS",ENDLINE)) S DATA=$G(^PRCP(445.2,+^TMP($J,"PRCPUTRS",ENDLINE),0)) I DATA'="" D
|
|
. . S Y=$P(DATA,"^",3)
|
|
. . W !?2,ENDLINE,?10,$P(DATA,"^",2),?20,$P(DATA,"^",19),?40,$P(DATA,"^",15),?50,$E(Y,4,5),"-",$E(Y,6,7),"-",$E(Y,2,3),?60,"IM#",$P(DATA,"^",5),?70,$E($$DESCR^PRCPUX1(PRCPINPT,+$P(DATA,"^",5)),1,9)
|
|
. I 'DA W !?2,"--- end of list ---"
|
|
. ;
|
|
. W !!,"Select an ENTRY from the list (from 1 to ",ENDLINE-1,"): "
|
|
. R X:DTIME I '$T!(X["^") S PRCPFLAG=1 Q
|
|
. I $D(^TMP($J,"PRCPUTRS",+X)) S SELECTDA=^(+X),PRCPFLAG=1 Q
|
|
. ;
|
|
. ; entire list displayed
|
|
. I 'DA S PRCPFLAG=1
|
|
K ^TMP($J,"PRCPUTRS")
|
|
Q +$G(SELECTDA)
|
|
;
|
|
;
|
|
INFOHELP ; display info help text
|
|
N HELP
|
|
S HELP(1)="You may lookup entries in the TRANSACTION REGISTER file by selecting: A) the transaction register id (A123 or RC456, etc); B) the transaction number which is the 2237, issue book, or purchase order number"
|
|
S HELP(2)="(460-94-2-120-0010 or 120-0010 if its the same quarter and year or purchase order G12345); C) the voucher number (I400001)."
|
|
W ! D DISPLAY^PRCPUX2(2,76,.HELP)
|
|
Q
|
|
;
|
|
;
|
|
HELP(Y) ; display help (if Y="" ask start with)
|
|
N DATA,DIR,LINE,PRCPFLAG,TRANID,X
|
|
I Y="" D I Y'="A",Y'="R",Y'="RC",Y'="C",Y'="U",Y'="P",Y'="S",Y'="E" Q
|
|
. S DIR(0)="S0^A:adjustment;RC:receipt;R:distribution regular;C:distribution call-in;E:distribution emergency;U:usage;P:physical count;S:case cart/instrument kit assembly or disassembly;"
|
|
. S DIR("A")=" Start HELP with entry type",DIR("B")="adjustment"
|
|
. D ^DIR
|
|
;
|
|
; show tranid entries
|
|
S TRANID=Y F LINE=1:1 S TRANID=$O(^PRCP(445.2,"T",PRCPINPT,TRANID)) Q:TRANID="" D I LINE#15=0 D P^PRCPUREP Q:$G(PRCPFLAG)
|
|
. S DATA=$G(^PRCP(445.2,+$O(^PRCP(445.2,"T",PRCPINPT,TRANID,0)),0)),Y=$P(DATA,"^",3)
|
|
. W !?2,"tranid:",?10,$P(DATA,"^",2),?20,$P(DATA,"^",19),?40,$P(DATA,"^",15),?50,$E(Y,4,5),"-",$E(Y,6,7),"-",$E(Y,2,3)
|
|
Q
|