73 lines
3.3 KiB
Mathematica
73 lines
3.3 KiB
Mathematica
PRCB8B ;WISC/PLT-AUTO GENERATE FMS VT-DOCUMENTS ;11/12/96 15:42
|
|
V ;;5.1;IFCAP;**71**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
QUIT ;invalid entry
|
|
;
|
|
;.X = record id of file 2100.1 if generated, "" if fail
|
|
;PRCFC data: ^1=ri of 440.7, ^2-...=date infor of prca from prcb1f
|
|
;PRCID data ^1=file 2100.1 ri, ^2= document id (if regenerated)
|
|
SV(X,PRCFC,PRCID) ;SV auto document
|
|
N PRCA,PRCB,PRCC,PRCDDT,PRCF,PRCQ,PRCRI,PRCSITE,PRCY,GECSFMS,PRCLACT,PRCAP,PRCDD,PRCDATA,PRCAMT
|
|
N PRCDI,PRCBOC,PRCEM,PRCIDL
|
|
N A,B,Z
|
|
S S PRCRI(440.7)=$P(PRCFC,"^"),A=$P(PRCFC,"^",12),PRCSITE=$P(A,"-",2)
|
|
S PRCEM="E" I $G(PRCID)]"" S PRCRI(2100.1)=+PRCID,PRCID=$P(PRCID,"^",2)
|
|
I $G(PRCID)="" S A=$P(PRCFC,"^",12),PRCID=PRCSITE_$E(A,2,7),PRCID=$E(PRCID,1,3)_$TR($E(PRCID,4,7),"1234567890","ABCDEFGHIJ")_$E(PRCID,8,999)
|
|
I $G(PRCRI(2100.1)) D REBUILD^GECSUFM1(PRCRI(2100.1),"I",$$SEC1^PRC0C(PRCSITE),"","Edited Rejected Auto SV Document")
|
|
;add entry in file 2100.1 if not rejected process
|
|
D:$G(PRCRI(2100.1))="" G EXIT:PRCRI(2100.1)<1
|
|
. D CONTROL^GECSUFMS("I",PRCSITE,PRCID,"SV",$$SEC1^PRC0C(PRCSITE),$S(PRCEM="M":1,1:0),"","Auto SV Document")
|
|
. S PRCRI(2100.1)=GECSFMS("DA")
|
|
. QUIT
|
|
D SETPARAM^GECSSDCT(PRCRI(2100.1),$P(PRCFC,"^")_"/"_$P(PRCFC,"^",12))
|
|
;set sv2 segment
|
|
S (PRCRI(440.701),PRCAMT)=0
|
|
F S PRCRI(440.701)=$O(^PRCH(440.7,PRCRI(440.7),50,PRCRI(440.701))) QUIT:'PRCRI(440.701) S PRCA=^(PRCRI(440.701),0) I $P(PRCA,"^",5)=""&($P(PRCA,"^",2)-$P(PRCA,"^",3))!$P(PRCA,"^",5) D
|
|
. S PRCAMT=$S($P(PRCA,"^",5)="":$P(PRCA,"^",2)-$P(PRCA,"^",3),1:$P(PRCA,"^",5))+PRCAMT
|
|
. QUIT
|
|
S PRCB=$$SV2 D SETCS^GECSSTAA(PRCRI(2100.1),PRCB)
|
|
;set line segemnt
|
|
S PRCRI(440.701)=0 F S PRCRI(440.701)=$O(^PRCH(440.7,PRCRI(440.7),50,PRCRI(440.701))) QUIT:'PRCRI(440.701) S PRCA=^(PRCRI(440.701),0),PRCAMT=$S($P(PRCA,"^",5)="":$P(PRCA,"^",2)-$P(PRCA,"^",3),1:$P(PRCA,"^",5)) D:PRCAMT
|
|
. S PRCB=$$LINE(PRCA) D SETCS^GECSSTAA(PRCRI(2100.1),PRCB)
|
|
. QUIT
|
|
D SETSTAT^GECSSTAA(PRCRI(2100.1),"Q")
|
|
EXIT S X=$G(PRCRI(2100.1))_"/"_PRCID
|
|
QUIT
|
|
;
|
|
SV2() ;create sv2
|
|
N PRCDATA,A,B
|
|
S A=$$DATE^PRC0C($P(PRCFC,"^",10)+40,"H")
|
|
S A=$$DATE^PRC0C($P(A,"^",4)_"/1/"_$P(A,"^",3),"E")
|
|
D PIECE($P(A,"^",9),13,2),PIECE($E($P(A,"^"),3,4),12,2)
|
|
S A=$$DATE^PRC0C(DT,"I")
|
|
D PIECE("SV2",1,3),PIECE($E($P(A,"^",3),3,4),2,2),PIECE($P(A,"^",4),3,2),PIECE($P(A,"^",5),4,2)
|
|
D PIECE($P(A,"^",9),5,2),PIECE($E($P(A,"^"),3,4),6,2)
|
|
S B=$S(PRCAMT<0:-PRCAMT,1:PRCAMT)
|
|
D PIECE(PRCEM,7,1),PIECE($J(B,0,2),16,15)
|
|
QUIT PRCDATA_"^~"
|
|
;
|
|
LINE(PRCA) ;assemble line
|
|
N PRCDATA,PRCLIN,PRCSVA,PRCSVB,PRCREQ
|
|
N A,B,C
|
|
S PRCLIN="LIN"
|
|
S PRCDATA="SVA"
|
|
S A=$$FUND^PRC0C($P(PRCA,"/"),$P(PRCA,"/",2))
|
|
D DOCREQ^PRC0C(+A,"SPE","PRCREQ")
|
|
D PIECE($E(1000+PRCRI(440.701),2,4),2,3),PIECE("CC",3,2)
|
|
S A=$O(^PRCD(420.14,"UNQ",$P(PRCA,"/"),$P(PRCA,"/",2),1))
|
|
D PIECE($E($P(PRCA,"/",2),3,4),4,2) D:$P(PRCA,"/",2)'=A PIECE($E(A,3,4),5,2)
|
|
D PIECE($P(PRCA,"/"),6,6),PIECE(PRCSITE,8,7)
|
|
I $G(PRCREQ("CC"))'="N" D PIECE($P(PRCA,"/",5),10,7),PIECE($E($P(PRCA,"/",5),5,6),11,2)
|
|
D PIECE($P(PRCA,"/",4),12,9),PIECE($P(PRCA,"/",6),13,4)
|
|
D PIECE(220,23,4)
|
|
S PRCSVA=PRCDATA
|
|
S PRCDATA="SVB"
|
|
S A=$S(PRCAMT<0:-PRCAMT,1:PRCAMT)
|
|
D PIECE($J(A,0,2),2,15),PIECE($S(PRCAMT<0:"D",1:"I"),3,1),PIECE("E",5,1)
|
|
S PRCSVB=PRCDATA
|
|
QUIT PRCLIN_"^~"_PRCSVA_"^~"_PRCSVB_"^~"
|
|
;
|
|
PIECE(A,B,C) ;set piece in variable PRCDATA, A-VALUE, B-PPECE #, C-LENGTH
|
|
S $P(PRCDATA,"^",B)=$E(A,1,C)
|
|
QUIT
|