PRCOCSC ;WISC/DJM - Generic Code Sheet Status Change ;4/23/96 9:53 AM
V ;;5.0;IFCAP;**70**;4/21/95
;CREATED FROM Tampa/RAK
EN ;-- entry point.
N %ZIS,CRDT,DIRPOP,PRINT,X,Y,ZTDESC,ZTRTN,ZTSAVE,%
S %H="56673,0"
D YMD^%DTC
S CRDT=X
;
W @IOF,*7,!!
W !?10,"This routine changes ALL code sheets created before "
W !?10,"'",$$FMTE^XLFDT(CRDT),"' that have a status of 'TRANSMITTED'"
W !?10,"and changes the status to 'ACCEPTED BY FMS'."
;
K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO"
W !! D ^DIR Q:Y'=1
;
K DIR S DIR(0)="Y",DIR("B")="NO"
S DIR("A")="Do you wish to print the Document Identifier of each code"
S DIR("A")=DIR("A")_"sheet changed"
W ! D ^DIR Q:Y="^" S PRINT=+Y
;
;-- get output device.
S %ZIS("S")="S AA=$G(^%ZIS(1,Y,""SUBTYPE"")) I AA>0,$E($G(^%ZIS(2,AA,0)),1)[""P"""
S %ZIS="QM",%ZIS("A")="Device: ",%ZIS("B")=""
W ! D ^%ZIS I POP W " no action taken." Q
I $D(IO("Q")) K IO("Q") D Q
.S ZTDESC="Change Generic Code Sheet Status"
.S ZTRTN="EN1^PRCOCSC",ZTSAVE("CRDT")="",ZTSAVE("PRINT")=""
.D ^%ZTLOAD W:$G(ZTSK) !,"Task #",ZTSK
.Q
;
EN1 ;-- entry point from taskman.
N COUNT,DATA,FDA,IEN,MESSAGE,NUMBER,OFFSET,PRTNUM,AA
S COUNT=0,OFFSET=25,NUMBER=IOM\OFFSET,PRTNUM=1
S CRDT=$G(CRDT),PRINT=+$G(PRINT)
I 'CRDT W !,"No Create Date (CRDT). Program exiting." D EXIT Q
U IO
W !,$$FMTE^XLFDT($$NOW^XLFDT)
W !
W !,"Changing Generic Code Sheets created before ",$$FMTE^XLFDT(CRDT)
W !," from a status of 'TRANSMITTED'"
W !," to a status of 'ACCEPTED BY FMS'."
W !
S IEN=0
;-- $order through the "AS" x-ref (STATUS).
F S IEN=$O(^GECS(2100.1,"AS","T",IEN)) Q:'IEN D
.Q:'$D(^GECS(2100.1,IEN,0)) S DATA=^(0)
.;
.;-- quit if DATE@TIME CREATED is not less than CRDT.
.Q:$P(DATA,U,3)'<CRDT
.;
.;-- make sure STATUS is 'transmitted'.
.Q:$P(DATA,U,4)'="T"
.;
.;-- if user selected to print document identifier.
.I PRINT D
..W:PRTNUM=1 !
..W ?($S(PRTNUM=1:0,1:OFFSET*(PRTNUM-1))),$P(DATA,U)
..S PRTNUM=$S(PRTNUM=NUMBER:1,1:PRTNUM+1)
.;
.K FDA,MESSAGE
.;
.;-- status.
.S FDA($J,2100.1,IEN_",",3)="A"
.;
.;-- change STATUS to'accepted by fms'.
.D FILE^DIE("","FDA($J)","MESSAGE")
.;
.;-- if error.
.I $D(MESSAGE) D Q
..W !,$P(DATA,U),!
..D MSG^DIALOG("W","",60,10,"MESSAGE")
..W !
.;
.S COUNT=COUNT+1
.;
.;-- if not printing document identifier and output is to a terminal
.;-- then print dots.
.W:'PRINT&($E(IOST,1,2)="C-")&('(COUNT#100)) "."
;
W !!,COUNT," record",$S(COUNT=1:"",1:"s")," updated."
;
EXIT ;
S:$D(ZTQUEUED) ZTREQ="@"
D ^%ZISC
S X="PRCOCSC"
S AA=^%ZOSF("DEL")
X AA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOCSC 2731 printed Dec 13, 2024@02:11:39 Page 2
PRCOCSC ;WISC/DJM - Generic Code Sheet Status Change ;4/23/96 9:53 AM
V ;;5.0;IFCAP;**70**;4/21/95
+1 ;CREATED FROM Tampa/RAK
EN ;-- entry point.
+1 NEW %ZIS,CRDT,DIRPOP,PRINT,X,Y,ZTDESC,ZTRTN,ZTSAVE,%
+2 SET %H="56673,0"
+3 DO YMD^%DTC
+4 SET CRDT=X
+5 ;
+6 WRITE @IOF,*7,!!
+7 WRITE !?10,"This routine changes ALL code sheets created before "
+8 WRITE !?10,"'",$$FMTE^XLFDT(CRDT),"' that have a status of 'TRANSMITTED'"
+9 WRITE !?10,"and changes the status to 'ACCEPTED BY FMS'."
+10 ;
+11 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="NO"
+12 WRITE !!
DO ^DIR
if Y'=1
QUIT
+13 ;
+14 KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
+15 SET DIR("A")="Do you wish to print the Document Identifier of each code"
+16 SET DIR("A")=DIR("A")_"sheet changed"
+17 WRITE !
DO ^DIR
if Y="^"
QUIT
SET PRINT=+Y
+18 ;
+19 ;-- get output device.
+20 SET %ZIS("S")="S AA=$G(^%ZIS(1,Y,""SUBTYPE"")) I AA>0,$E($G(^%ZIS(2,AA,0)),1)[""P"""
+21 SET %ZIS="QM"
SET %ZIS("A")="Device: "
SET %ZIS("B")=""
+22 WRITE !
DO ^%ZIS
IF POP
WRITE " no action taken."
QUIT
+23 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+24 SET ZTDESC="Change Generic Code Sheet Status"
+25 SET ZTRTN="EN1^PRCOCSC"
SET ZTSAVE("CRDT")=""
SET ZTSAVE("PRINT")=""
+26 DO ^%ZTLOAD
if $GET(ZTSK)
WRITE !,"Task #",ZTSK
+27 QUIT
End DoDot:1
QUIT
+28 ;
EN1 ;-- entry point from taskman.
+1 NEW COUNT,DATA,FDA,IEN,MESSAGE,NUMBER,OFFSET,PRTNUM,AA
+2 SET COUNT=0
SET OFFSET=25
SET NUMBER=IOM\OFFSET
SET PRTNUM=1
+3 SET CRDT=$GET(CRDT)
SET PRINT=+$GET(PRINT)
+4 IF 'CRDT
WRITE !,"No Create Date (CRDT). Program exiting."
DO EXIT
QUIT
+5 USE IO
+6 WRITE !,$$FMTE^XLFDT($$NOW^XLFDT)
+7 WRITE !
+8 WRITE !,"Changing Generic Code Sheets created before ",$$FMTE^XLFDT(CRDT)
+9 WRITE !," from a status of 'TRANSMITTED'"
+10 WRITE !," to a status of 'ACCEPTED BY FMS'."
+11 WRITE !
+12 SET IEN=0
+13 ;-- $order through the "AS" x-ref (STATUS).
+14 FOR
SET IEN=$ORDER(^GECS(2100.1,"AS","T",IEN))
if 'IEN
QUIT
Begin DoDot:1
+15 if '$DATA(^GECS(2100.1,IEN,0))
QUIT
SET DATA=^(0)
+16 ;
+17 ;-- quit if DATE@TIME CREATED is not less than CRDT.
+18 if $PIECE(DATA,U,3)'<CRDT
QUIT
+19 ;
+20 ;-- make sure STATUS is 'transmitted'.
+21 if $PIECE(DATA,U,4)'="T"
QUIT
+22 ;
+23 ;-- if user selected to print document identifier.
+24 IF PRINT
Begin DoDot:2
+25 if PRTNUM=1
WRITE !
+26 WRITE ?($SELECT(PRTNUM=1:0,1:OFFSET*(PRTNUM-1))),$PIECE(DATA,U)
+27 SET PRTNUM=$SELECT(PRTNUM=NUMBER:1,1:PRTNUM+1)
End DoDot:2
+28 ;
+29 KILL FDA,MESSAGE
+30 ;
+31 ;-- status.
+32 SET FDA($JOB,2100.1,IEN_",",3)="A"
+33 ;
+34 ;-- change STATUS to'accepted by fms'.
+35 DO FILE^DIE("","FDA($J)","MESSAGE")
+36 ;
+37 ;-- if error.
+38 IF $DATA(MESSAGE)
Begin DoDot:2
+39 WRITE !,$PIECE(DATA,U),!
+40 DO MSG^DIALOG("W","",60,10,"MESSAGE")
+41 WRITE !
End DoDot:2
QUIT
+42 ;
+43 SET COUNT=COUNT+1
+44 ;
+45 ;-- if not printing document identifier and output is to a terminal
+46 ;-- then print dots.
+47 if 'PRINT&($EXTRACT(IOST,1,2)="C-")&('(COUNT#100))
WRITE "."
End DoDot:1
+48 ;
+49 WRITE !!,COUNT," record",$SELECT(COUNT=1:"",1:"s")," updated."
+50 ;
EXIT ;
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 DO ^%ZISC
+3 SET X="PRCOCSC"
+4 SET AA=^%ZOSF("DEL")
+5 XECUTE AA
+6 QUIT
