source: FOIAVistA/trunk/r/GENERIC_CODE_SHEET-GEC/GECSSDCT.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1GECSSDCT ;WISC/RFJ-dct accept,reject message utilities ;25 Apr 94
2 ;;2.0;GCS;;MAR 14, 1995
3 Q
4 ;
5 ;
6SETCODE(DA,CODE) ; set event code to be called for accept/reject msg
7 ; da = stack internal entry number
8 ; code = D LABEL^ROUTINE
9 ; when the code gets called, it will pass the 1) document number,
10 ; 2) 'A'ccepted or 'R'ejected, 3) reject message in ^TMP($J,
11 ; "GECSSDCT",line#,0)
12 I CODE="" Q
13 I $P(CODE,"^")="D " Q
14 I $E(CODE,1,2)'="D " Q
15 N X
16 S X=CODE D ^DIM I '$D(X) Q
17 I '$D(^GECS(2100.1,DA,0)) Q
18 L +^GECS(2100.1,DA,25)
19 S ^GECS(2100.1,DA,25)=CODE
20 L -^GECS(2100.1,DA,25)
21 Q
22 ;
23 ;
24SETPARAM(DA,PARAM) ; set parameters to be used to rebuild the code sheet
25 ; da = stack internal entry number
26 ; param = parameters used free text from 1-200 characters
27 I PARAM="" Q
28 I '$D(^GECS(2100.1,DA,0)) Q
29 L +^GECS(2100.1,DA,26)
30 S ^GECS(2100.1,DA,26)=PARAM
31 L -^GECS(2100.1,DA,26)
32 Q
33 ;
34 ;
35PROCESS(DOCID,ACCORREJ) ; call to process dct for accept or reject msg
36 ; docid = document identifier (entry in 2100.1 stack file)
37 ; accorrej = 'A'ccept or 'R'eject
38 ; pass reject message in ^TMP($J,"GECSSDCT",line#,0)
39 ; start line# with 1 -------------^
40 N DA,CODE,X
41 S DOCID=$$PADSPACE^GECSSGET(DOCID)
42 S DA=+$O(^GECS(2100.1,"B",DOCID,0)) I 'DA Q
43 I ACCORREJ'="A",ACCORREJ'="R" Q
44 ; set status in stack file
45 D SETSTAT^GECSSTAA(DA,ACCORREJ)
46 ; for rejects, send mailman message
47 I ACCORREJ="R",$D(^TMP($J,"GECSSDCT",1,0)) D MAILMSG(DOCID)
48 ; if event code, call it and quit
49 S CODE=$G(^GECS(2100.1,DA,25))
50 I CODE'="" S X=CODE D ^DIM I $D(X) S X=$P(CODE,"^",2) X ^%ZOSF("TEST") I $T S CODE=CODE_"(DOCID,ACCORREJ)" X CODE D Q Q
51 ; no event code, and accepted, purge code sheet from stack
52 I ACCORREJ="A" D KILLCS(DOCID)
53Q ; clean up
54 K ^TMP($J,"GECSSDCT")
55 Q
56 ;
57 ;
58KILLSTAC(DOCID) ; purge stack file entry docid
59 N DA
60 S DOCID=$$PADSPACE^GECSSGET(DOCID)
61 S DA=+$O(^GECS(2100.1,"B",DOCID,0)) I 'DA Q
62 I '$D(^GECS(2100.1,DA)) Q
63 D KILLSTAC^GECSPUR1(DA)
64 Q
65 ;
66 ;
67KILLCS(DOCID) ; remove code sheet from stack file entry
68 N DA
69 S DOCID=$$PADSPACE^GECSSGET(DOCID)
70 S DA=+$O(^GECS(2100.1,"B",DOCID,0)) I 'DA Q
71 K ^GECS(2100.1,DA,10),^GECS(2100.1,DA,11)
72 Q
73 ;
74 ;
75MAILMSG(DOCID) ; send mail message for rejects
76 ; docid = document identifier (file 2100.1 stack file entry)
77 ; ^tmp($j,"gecssdct",line#,0) = reject message
78 N %,%X,%Y,GECSXMY,SEGMENT,XCNP,XMDISPI,XMDUZ,XMTEXT,XMY,XMZ,ZTSK
79 S SEGMENT=$E(DOCID,1,2)_":FMS"
80 I '$O(^GECS(2101.2,"B",SEGMENT,0)) Q
81 ;
82 ; build receiving queue and user array
83 D RECUSER^GECSSTTR(SEGMENT,1)
84 I '$D(GECSXMY) Q
85 S %X="GECSXMY(",%Y="XMY(" D %XY^%RCR
86 ;
87 S XMDUZ=$S($D(ZTQUEUED):.5,'$G(DUZ):.5,1:DUZ),XMTEXT="^TMP($J,""GECSSDCT"",",XMSUB="GCS TRANSACTION "_SEGMENT_" REJECT IN FMS"
88 K XMZ D ^XMD
89 Q
Note: See TracBrowser for help on using the repository browser.