| [613] | 1 | PRCOCSC ;WISC/DJM - Generic Code Sheet Status Change ;4/23/96 9:53 AM
|
|---|
| 2 | V ;;5.0;IFCAP;**70**;4/21/95
|
|---|
| 3 | ;CREATED FROM Tampa/RAK
|
|---|
| 4 | EN ;-- entry point.
|
|---|
| 5 | N %ZIS,CRDT,DIRPOP,PRINT,X,Y,ZTDESC,ZTRTN,ZTSAVE,%
|
|---|
| 6 | S %H="56673,0"
|
|---|
| 7 | D YMD^%DTC
|
|---|
| 8 | S CRDT=X
|
|---|
| 9 | ;
|
|---|
| 10 | W @IOF,*7,!!
|
|---|
| 11 | W !?10,"This routine changes ALL code sheets created before "
|
|---|
| 12 | W !?10,"'",$$FMTE^XLFDT(CRDT),"' that have a status of 'TRANSMITTED'"
|
|---|
| 13 | W !?10,"and changes the status to 'ACCEPTED BY FMS'."
|
|---|
| 14 | ;
|
|---|
| 15 | K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO"
|
|---|
| 16 | W !! D ^DIR Q:Y'=1
|
|---|
| 17 | ;
|
|---|
| 18 | K DIR S DIR(0)="Y",DIR("B")="NO"
|
|---|
| 19 | S DIR("A")="Do you wish to print the Document Identifier of each code"
|
|---|
| 20 | S DIR("A")=DIR("A")_"sheet changed"
|
|---|
| 21 | W ! D ^DIR Q:Y="^" S PRINT=+Y
|
|---|
| 22 | ;
|
|---|
| 23 | ;-- get output device.
|
|---|
| 24 | S %ZIS("S")="S AA=$G(^%ZIS(1,Y,""SUBTYPE"")) I AA>0,$E($G(^%ZIS(2,AA,0)),1)[""P"""
|
|---|
| 25 | S %ZIS="QM",%ZIS("A")="Device: ",%ZIS("B")=""
|
|---|
| 26 | W ! D ^%ZIS I POP W " no action taken." Q
|
|---|
| 27 | I $D(IO("Q")) K IO("Q") D Q
|
|---|
| 28 | .S ZTDESC="Change Generic Code Sheet Status"
|
|---|
| 29 | .S ZTRTN="EN1^PRCOCSC",ZTSAVE("CRDT")="",ZTSAVE("PRINT")=""
|
|---|
| 30 | .D ^%ZTLOAD W:$G(ZTSK) !,"Task #",ZTSK
|
|---|
| 31 | .Q
|
|---|
| 32 | ;
|
|---|
| 33 | EN1 ;-- entry point from taskman.
|
|---|
| 34 | N COUNT,DATA,FDA,IEN,MESSAGE,NUMBER,OFFSET,PRTNUM,AA
|
|---|
| 35 | S COUNT=0,OFFSET=25,NUMBER=IOM\OFFSET,PRTNUM=1
|
|---|
| 36 | S CRDT=$G(CRDT),PRINT=+$G(PRINT)
|
|---|
| 37 | I 'CRDT W !,"No Create Date (CRDT). Program exiting." D EXIT Q
|
|---|
| 38 | U IO
|
|---|
| 39 | W !,$$FMTE^XLFDT($$NOW^XLFDT)
|
|---|
| 40 | W !
|
|---|
| 41 | W !,"Changing Generic Code Sheets created before ",$$FMTE^XLFDT(CRDT)
|
|---|
| 42 | W !," from a status of 'TRANSMITTED'"
|
|---|
| 43 | W !," to a status of 'ACCEPTED BY FMS'."
|
|---|
| 44 | W !
|
|---|
| 45 | S IEN=0
|
|---|
| 46 | ;-- $order through the "AS" x-ref (STATUS).
|
|---|
| 47 | F S IEN=$O(^GECS(2100.1,"AS","T",IEN)) Q:'IEN D
|
|---|
| 48 | .Q:'$D(^GECS(2100.1,IEN,0)) S DATA=^(0)
|
|---|
| 49 | .;
|
|---|
| 50 | .;-- quit if DATE@TIME CREATED is not less than CRDT.
|
|---|
| 51 | .Q:$P(DATA,U,3)'<CRDT
|
|---|
| 52 | .;
|
|---|
| 53 | .;-- make sure STATUS is 'transmitted'.
|
|---|
| 54 | .Q:$P(DATA,U,4)'="T"
|
|---|
| 55 | .;
|
|---|
| 56 | .;-- if user selected to print document identifier.
|
|---|
| 57 | .I PRINT D
|
|---|
| 58 | ..W:PRTNUM=1 !
|
|---|
| 59 | ..W ?($S(PRTNUM=1:0,1:OFFSET*(PRTNUM-1))),$P(DATA,U)
|
|---|
| 60 | ..S PRTNUM=$S(PRTNUM=NUMBER:1,1:PRTNUM+1)
|
|---|
| 61 | .;
|
|---|
| 62 | .K FDA,MESSAGE
|
|---|
| 63 | .;
|
|---|
| 64 | .;-- status.
|
|---|
| 65 | .S FDA($J,2100.1,IEN_",",3)="A"
|
|---|
| 66 | .;
|
|---|
| 67 | .;-- change STATUS to'accepted by fms'.
|
|---|
| 68 | .D FILE^DIE("","FDA($J)","MESSAGE")
|
|---|
| 69 | .;
|
|---|
| 70 | .;-- if error.
|
|---|
| 71 | .I $D(MESSAGE) D Q
|
|---|
| 72 | ..W !,$P(DATA,U),!
|
|---|
| 73 | ..D MSG^DIALOG("W","",60,10,"MESSAGE")
|
|---|
| 74 | ..W !
|
|---|
| 75 | .;
|
|---|
| 76 | .S COUNT=COUNT+1
|
|---|
| 77 | .;
|
|---|
| 78 | .;-- if not printing document identifier and output is to a terminal
|
|---|
| 79 | .;-- then print dots.
|
|---|
| 80 | .W:'PRINT&($E(IOST,1,2)="C-")&('(COUNT#100)) "."
|
|---|
| 81 | ;
|
|---|
| 82 | W !!,COUNT," record",$S(COUNT=1:"",1:"s")," updated."
|
|---|
| 83 | ;
|
|---|
| 84 | EXIT ;
|
|---|
| 85 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 86 | D ^%ZISC
|
|---|
| 87 | S X="PRCOCSC"
|
|---|
| 88 | S AA=^%ZOSF("DEL")
|
|---|
| 89 | X AA
|
|---|
| 90 | Q
|
|---|
