| 1 | GECSSDCT ;WISC/RFJ-dct accept,reject message utilities ;25 Apr 94
|
|---|
| 2 | ;;2.0;GCS;;MAR 14, 1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | SETCODE(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 | ;
|
|---|
| 24 | SETPARAM(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 | ;
|
|---|
| 35 | PROCESS(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)
|
|---|
| 53 | Q ; clean up
|
|---|
| 54 | K ^TMP($J,"GECSSDCT")
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | ;
|
|---|
| 58 | KILLSTAC(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 | ;
|
|---|
| 67 | KILLCS(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 | ;
|
|---|
| 75 | MAILMSG(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
|
|---|
