Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCOCSC

PRCOCSC.m

Go to the documentation of this file.
  1. PRCOCSC ;WISC/DJM - Generic Code Sheet Status Change ;4/23/96 9:53 AM
  1. V ;;5.0;IFCAP;**70**;4/21/95
  1. ;CREATED FROM Tampa/RAK
  1. EN ;-- entry point.
  1. N %ZIS,CRDT,DIRPOP,PRINT,X,Y,ZTDESC,ZTRTN,ZTSAVE,%
  1. S %H="56673,0"
  1. D YMD^%DTC
  1. S CRDT=X
  1. ;
  1. W @IOF,*7,!!
  1. W !?10,"This routine changes ALL code sheets created before "
  1. W !?10,"'",$$FMTE^XLFDT(CRDT),"' that have a status of 'TRANSMITTED'"
  1. W !?10,"and changes the status to 'ACCEPTED BY FMS'."
  1. ;
  1. K DIR S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO"
  1. W !! D ^DIR Q:Y'=1
  1. ;
  1. K DIR S DIR(0)="Y",DIR("B")="NO"
  1. S DIR("A")="Do you wish to print the Document Identifier of each code"
  1. S DIR("A")=DIR("A")_"sheet changed"
  1. W ! D ^DIR Q:Y="^" S PRINT=+Y
  1. ;
  1. ;-- get output device.
  1. S %ZIS("S")="S AA=$G(^%ZIS(1,Y,""SUBTYPE"")) I AA>0,$E($G(^%ZIS(2,AA,0)),1)[""P"""
  1. S %ZIS="QM",%ZIS("A")="Device: ",%ZIS("B")=""
  1. W ! D ^%ZIS I POP W " no action taken." Q
  1. I $D(IO("Q")) K IO("Q") D Q
  1. .S ZTDESC="Change Generic Code Sheet Status"
  1. .S ZTRTN="EN1^PRCOCSC",ZTSAVE("CRDT")="",ZTSAVE("PRINT")=""
  1. .D ^%ZTLOAD W:$G(ZTSK) !,"Task #",ZTSK
  1. .Q
  1. ;
  1. EN1 ;-- entry point from taskman.
  1. N COUNT,DATA,FDA,IEN,MESSAGE,NUMBER,OFFSET,PRTNUM,AA
  1. S COUNT=0,OFFSET=25,NUMBER=IOM\OFFSET,PRTNUM=1
  1. S CRDT=$G(CRDT),PRINT=+$G(PRINT)
  1. I 'CRDT W !,"No Create Date (CRDT). Program exiting." D EXIT Q
  1. U IO
  1. W !,$$FMTE^XLFDT($$NOW^XLFDT)
  1. W !
  1. W !,"Changing Generic Code Sheets created before ",$$FMTE^XLFDT(CRDT)
  1. W !," from a status of 'TRANSMITTED'"
  1. W !," to a status of 'ACCEPTED BY FMS'."
  1. W !
  1. S IEN=0
  1. ;-- $order through the "AS" x-ref (STATUS).
  1. F S IEN=$O(^GECS(2100.1,"AS","T",IEN)) Q:'IEN D
  1. .Q:'$D(^GECS(2100.1,IEN,0)) S DATA=^(0)
  1. .;
  1. .;-- quit if DATE@TIME CREATED is not less than CRDT.
  1. .Q:$P(DATA,U,3)'<CRDT
  1. .;
  1. .;-- make sure STATUS is 'transmitted'.
  1. .Q:$P(DATA,U,4)'="T"
  1. .;
  1. .;-- if user selected to print document identifier.
  1. .I PRINT D
  1. ..W:PRTNUM=1 !
  1. ..W ?($S(PRTNUM=1:0,1:OFFSET*(PRTNUM-1))),$P(DATA,U)
  1. ..S PRTNUM=$S(PRTNUM=NUMBER:1,1:PRTNUM+1)
  1. .;
  1. .K FDA,MESSAGE
  1. .;
  1. .;-- status.
  1. .S FDA($J,2100.1,IEN_",",3)="A"
  1. .;
  1. .;-- change STATUS to'accepted by fms'.
  1. .D FILE^DIE("","FDA($J)","MESSAGE")
  1. .;
  1. .;-- if error.
  1. .I $D(MESSAGE) D Q
  1. ..W !,$P(DATA,U),!
  1. ..D MSG^DIALOG("W","",60,10,"MESSAGE")
  1. ..W !
  1. .;
  1. .S COUNT=COUNT+1
  1. .;
  1. .;-- if not printing document identifier and output is to a terminal
  1. .;-- then print dots.
  1. .W:'PRINT&($E(IOST,1,2)="C-")&('(COUNT#100)) "."
  1. ;
  1. W !!,COUNT," record",$S(COUNT=1:"",1:"s")," updated."
  1. ;
  1. EXIT ;
  1. S:$D(ZTQUEUED) ZTREQ="@"
  1. D ^%ZISC
  1. S X="PRCOCSC"
  1. S AA=^%ZOSF("DEL")
  1. X AA
  1. Q