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

PRC5CON1.m

Go to the documentation of this file. 
  1. PRC5CON1 ;WISC/PLT-PRC5CON CONTINUE ; 08/22/95  3:18 PM
  1. V ;;5.0;IFCAP;**27**;4/21/95
  1.  ;QUIT  ; invalid entry
  1.  ;
  1. EN ;start station merge/convert CALM code sheet to FMS
  1.  N PRCRI,PRCSITE,PRCYEAR,PRCYE,PRCQTR,PRCFCP,PRCDATE
  1.  N PRCA,PRCB,PRCC
  1.  S PRCYEAR=1996,PRCYE=96,PRCDATE=2950930
  1.  S PRCRI(420)=0 F  S PRCRI(420)=$O(^PRC(420,PRCRI(420))) QUIT:'PRCRI(420)  S PRCC="" D  QUIT:PRCC=-1
  1.  . D EN^DDIOL("STATION # "_PRCRI(420)_" starts:")
  1.  . S PRCSITE=PRCRI(420)
  1.  . D @("AUTO"_PRCDD)
  1.  . QUIT
  1.  I PRCC=-1 W !! F I=1:1:4 W "ABORTED BY '^'!    "
  1.  E  W !! F I=1:1:5 W "ALL DONE!   "
  1.  QUIT
  1.  ;
  1.  ;
  1. AUTO410 ;auto select file 410 for 1996
  1.  S PRCA=PRCSITE_"-"_PRCYE
  1.  S PRCB=PRCA F  S PRCB=$O(^PRCS(410,"B",PRCB)) QUIT:PRCA-PRCB  S PRCRI(410)=$O(^(PRCB,"")) D:PRCRI(410) 410  QUIT:PRCC=-1
  1.  QUIT
  1.  ;
  1. AUTO442 ;auto select file 442 for 1996
  1.  S PRCA=PRCDATE
  1.  S PRCB=PRCA F  S PRCB=$O(^PRC(442,"AB",PRCB)) QUIT:'PRCB  D  QUIT:PRCC=-1
  1.  . S PRCRI(442)=0 F  S PRCRI(442)=$O(^PRC(442,"AB",PRCB,PRCRI(442))) QUIT:'PRCRI(442)  D:^PRC(442,PRCRI(442),0)-PRCSITE=0 442 QUIT:PRCC=-1
  1.  . QUIT
  1.  QUIT
  1.  ;
  1. 410 ;display/edit substation
  1.  W ! D  ;display
  1.  . N DIC,DA,DR,WIQ
  1.  . S DIC="^PRCS(410,",DA=PRCRI(410),DR="0;4;RM" D EN^DIQ
  1.  . QUIT
  1.  S PRC("SITE")=+^PRCS(410,PRCRI(410),0)
  1.  D EDIT^PRC0B(.X,"410;;"_PRCRI(410),"448","")
  1.  S PRCC=X
  1.  D EN^DDIOL(" "),EN^DDIOL($TR($J("",78)," ","-"))
  1.  QUIT
  1.  ;
  1. 442 ;display/edit substation
  1.  W ! D  ;display
  1.  . N DIC,DA,DR,WIQ
  1.  . S DIC="^PRC(442,",DA=PRCRI(442),DR="0;12;4" D EN^DIQ
  1.  . W "    PURCHASE ORDER DATE: ",$E(PRCB,4,5),"/",$E(PRCB,6,7),"/",$E(PRCB,2,3)
  1.  . QUIT
  1.  S PRC("SITE")=+^PRC(442,PRCRI(442),0)
  1.  D EDIT^PRC0B(.X,"442;;"_PRCRI(442),"31","")
  1.  S PRCC=X
  1.  D EN^DDIOL(" "),EN^DDIOL($TR($J("",78)," ","-"))
  1.  QUIT
  1.  ;
  1. EN1 D @("MAN"_PRCDD)
  1.  QUIT
  1.  ;
  1. ACCRUE ;enter accrue for 1996 txn if method of processing is certified invoice
  1.  N PRCRI,PRCSITE,PRCYEAR,PRCYE,PRCQTR,PRCFCP,PRCDATE
  1.  N PRCA,PRCB,PRCC
  1.  S PRCYEAR=1996,PRCYE=96,PRCDATE=2950930
  1.  S PRCRI(420)=0 F  S PRCRI(420)=$O(^PRC(420,PRCRI(420))) QUIT:'PRCRI(420)  S PRCC="" D  QUIT:PRCC=-1
  1.  . D EN^DDIOL("STATION # "_PRCRI(420)_" starts:")
  1.  . S PRCSITE=PRCRI(420)
  1.  . D ACC58 QUIT:PRCC=-1  D ACCPO
  1.  . QUIT
  1.  I PRCC=-1 W !! F I=1:1:4 W "ABORTED BY '^'!    "
  1.  E  W !! F I=1:1:5 W "ALL DONE!   "
  1.  QUIT
  1.  ;
  1. ACC58 ;ACCURE FOR 1358
  1.  S PRCA=PRCSITE_"-"_PRCYE,PRCB=PRCA
  1.  F  S PRCB=$O(^PRCS(410,"B",PRCB)) QUIT:PRCA-PRCB  S PRCRI(410)=$O(^(PRCB,"")) I PRCRI(410) D  QUIT:PRCC=-1
  1.  . N PRCB
  1.  . I $P(^PRCS(410,PRCRI(410),0),"^",4)=1,$P($G(^(4)),"^",10)]"" S PRCRI(442)=$P($G(^(10)),"^",3) I PRCRI(442) I $O(^PRC(442,PRCRI(442),10,0)) S PRCB=$P($G(^PRC(442,PRCRI(442),1)),"^",15) D ACC442
  1.  . QUIT
  1.  QUIT
  1.  ;
  1.  ;
  1. ACCPO S PRCA=PRCDATE
  1.  S PRCB=PRCA F  S PRCB=$O(^PRC(442,"AB",PRCB)) QUIT:'PRCB  D  QUIT:PRCC=-1
  1.  . S PRCRI(442)=0 F  S PRCRI(442)=$O(^PRC(442,"AB",PRCB,PRCRI(442))) QUIT:'PRCRI(442)  D:^PRC(442,PRCRI(442),0)-PRCSITE=0&($P(^(0),"^",2)=2)&($P($G(^(12)),"^",2)]"") ACC442 QUIT:PRCC=-1
  1.  . QUIT
  1.  QUIT
  1.  ;
  1. ACC442 ;enter accrue flag and ending contract date if certified
  1.  W ! D  ;display
  1.  . N DIC,DA,DR,WIQ
  1.  . S DIC="^PRC(442,",DA=PRCRI(442),DR="0;12;4" D EN^DIQ
  1.  . W "    PURCHASE ORDER DATE: " W:PRCB]"" $E(PRCB,4,5),"/",$E(PRCB,6,7),"/",$E(PRCB,2,3)
  1.  . QUIT
  1.  S PRC("SITE")=+^PRC(442,PRCRI(442),0)
  1.  D EDIT^PRC0B(.X,"442;;"_PRCRI(442),"30;29","")
  1.  S PRCC=X
  1.  D EN^DDIOL(" "),EN^DDIOL($TR($J("",78)," ","-"))
  1.  QUIT
  1.  ;
  1. MAN410 ;manual select 410 for 1996
  1.  S X("S")="I $P($G(^(0)),""-"",2)>95"
  1.  D LOOKUP^PRC0B(.X,.Y,"410","AEMOQS","Select 2237/1358 Request: ")
  1.  I X=""!(X["^") QUIT
  1.  I Y>0 S PRCRI(410)=+Y D 410
  1.  G MAN410
  1.  QUIT
  1.  ;
  1. MAN442 ;MANUAL SELECT 442 for 1996
  1.  S X("S")="I $P($G(^(1)),""^"",15)>2950930"
  1.  D LOOKUP^PRC0B(.X,.Y,"442","AEMOQS","Select Purchase Order: ")
  1.  I X=""!(X["^") QUIT
  1.  I Y>0 S PRCRI(442)=+Y,PRCB=$P($G(^PRC(442,PRCRI(442),1)),"^",15) D 442
  1.  G MAN442
  1.  ;