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

ACRFSPL1.m

Go to the documentation of this file. 
  1. ACRFSPL1 ;IHS/OIRM/DSD/AEF - DHR-SPLITOUT [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1.  ;
  1.  ;This routine produces a display of batches available for export and 
  1.  ;prompts the user for which batch to export.  The variable ACRD0 is
  1.  ;returned set to the internal number of the batch to be exported.
  1.  ;
  1.  ;
  1. EN(ACRCTR,ACRDTNM,ACRPKG)    ;EP
  1.  ;----- MAIN ENTRY POINT
  1.  ;
  1.  ;      ACRCTR  = TYPE OF TRANSACTIONS
  1.  ;                ARM = ARMS
  1.  ;                BCS = CHS
  1.  ;                PCC = MANUALLY ENTERED
  1.  ;      ACRDTNM = DATA TYPE NAME
  1.  ;                DHRP
  1.  ;                dhc
  1.  ;      ACRPKG  = PACKAGE
  1.  ;                AFSH = ARMS
  1.  ;                ACHS = CHS
  1.  ;
  1.  N ACR,ACRDISP,ACRNTRB,ACRNTRL,ACROUT,ACRZ
  1.  D ^XBKVAR
  1.  D HOME^%ZIS
  1.  D HDR
  1.  D GET
  1.  D HDR1
  1.  D HDR2
  1.  D HDR3
  1.  D SHOW
  1.  D PROMPT
  1.  I $G(ACROUT) K ACRD0 Q
  1.  Q
  1. GET ;----- GETS DATA TO DISPLAY
  1.  ;
  1.  ;      ACRD0 = BATCH COLOR
  1.  ;              1 = PCC-BLUE
  1.  ;              2 = PCC-RED
  1.  ;              3 = CHS-BLUE
  1.  ;              4 = CHS-RED
  1.  ;              5 = ARMS-BLUE
  1.  ;              6 = ARMS-RED
  1.  ;
  1.  N ACRD0
  1.  K ACR
  1.  I ACRCTR="PCC" F ACRD0=1,2 D LOOP(ACRD0)
  1.  I ACRCTR="BCS" F ACRD0=3,4 D LOOP(ACRD0)
  1.  I ACRCTR="ARM" F ACRD0=5,6 D LOOP(ACRD0)
  1.  D DISP
  1.  Q
  1. LOOP(ACRD0)        ;
  1.  ;----- LOOPS THROUGH THE BATCH COLOR ENTRIES TO GATHER DATA FOR DISPLAY
  1.  ;
  1.  ;      DATA = REUSABLE DATA VARIABLE
  1.  ;      ACR  = ARRAY CONTAINING BATCH DATA:
  1.  ;             ACR(COLORIEN,BATCHDATE)=1ST BATCHID^LAST BATCHID^NUMBER
  1.  ;             OF BATCHES^NUMBER OF RECORDS^NUMBER OF NO TRAILERS
  1.  ;
  1.  N ACRD1,ACRD2,ACRD3,DATA
  1.  S ACRD1=0
  1.  F  S ACRD1=$O(^AFSHRCDS(ACRD0,"D",ACRD1)) Q:'ACRD1  D
  1.  . S ACR(ACRD0,ACRD1)=""
  1.  . S DATA=$P(^AFSHRCDS(ACRD0,0),U,2) ;color export date
  1.  . S ACR(ACRD0,"STATUS")=$S(DATA="":"E",1:"T")_U_DATA
  1.  . S ACRD2=0
  1.  . F  S ACRD2=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2)) Q:'ACRD2  D
  1.  . . S DATA=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0)
  1.  . . I $P(ACR(ACRD0,ACRD1),U)="" S $P(ACR(ACRD0,ACRD1),U)=$P(DATA,U)
  1.  . . S $P(ACR(ACRD0,ACRD1),U,2)=$P(DATA,U)
  1.  . . S $P(ACR(ACRD0,ACRD1),U,3)=$P(ACR(ACRD0,ACRD1),U,3)+1
  1.  . . I $P(DATA,U,3)'="C" D
  1.  . . . S $P(ACR(ACRD0,ACRD1),U,5)=$P(ACR(ACRD0,ACRD1),U,5)+1
  1.  . . . S ACRNTRL(ACRD0)=1
  1.  . . . S ACRNTRB(ACRD0,ACRD1,$P(DATA,U))=""
  1.  . . S ACRD3=0
  1.  . . F  S ACRD3=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3)) Q:'ACRD3  D
  1.  . . . S $P(ACR(ACRD0,ACRD1),U,4)=$P(ACR(ACRD0,ACRD1),U,4)+1
  1.  Q
  1. DISP ;----- BUILDS DISPLAY ARRAY
  1.  ;
  1.  N ACRD0,ACRD1,CNT
  1.  S (ACRZ(1),ACRZ(2),ACRD0)=0
  1.  F  S ACRD0=$O(ACR(ACRD0)) Q:'ACRD0  D
  1.  . S (ACRD1,CNT)=0
  1.  . F  S ACRD1=$O(ACR(ACRD0,ACRD1)) Q:'ACRD1  D
  1.  . . S CNT=CNT+1
  1.  . . S $P(ACRDISP(CNT),";",$S(ACRD0#2:1,1:2))=ACRD1_U_ACR(ACRD0,ACRD1)
  1.  . . S ACRZ($S(ACRD0#2:1,1:2))=1
  1.  Q
  1. SHOW ;----- SHOW BATCHES
  1.  ;
  1.  N DATA,I,PC
  1.  S I=0
  1.  F  S I=$O(ACRDISP(I)) Q:'I  D
  1.  . W !
  1.  . F PC=1,2 D
  1.  . . S DATA=$P(ACRDISP(I),";",PC)
  1.  . . W ?$S(PC=1:5,1:41)
  1.  . . W $$DATE($P(DATA,U))
  1.  . . W "   "
  1.  . . W $J($P(DATA,U,4),3)
  1.  . . W "   "
  1.  . . W $P(DATA,U,2)_$S($P(DATA,U,2)]"":"-",1:"")_$P(DATA,U,3)
  1.  . . W "  "
  1.  . . W $J($P(DATA,U,5),4)
  1.  . . W "  "
  1.  . . W $J($P(DATA,U,6),3)
  1.  . . I PC=1 W "    |"
  1.  Q
  1. DATE(X) ;----- RETURNS DATE IN MM/DD/YY FORMAT
  1.  ;
  1.  I X]"" S X=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1.  Q X
  1.  ;
  1. PROMPT ;----- PROMPTS USER FOR WHICH BATCH TO EXPORT
  1.  ;
  1.  N DIR,X,Y
  1.  S DIR(0)="SBM^B:BLUE;R:RED"
  1.  S DIR("A")="Enter Batch COLOR to USE"
  1.  W !
  1.  D ^DIR
  1.  I $D(DIRUT) S ACROUT=1 Q
  1.  I Y="B" S ACRD0=$S(ACRCTR="PCC":1,ACRCTR="BCS":3,ACRCTR="ARM":5,1:"")
  1.  I Y="R" S ACRD0=$S(ACRCTR="PCC":2,ACRCTR="BCS":4,ACRCTR="ARM":6,1:"")
  1.  I '$G(ACRD0) S ACROUT=1 Q
  1.  I '$D(ACR(ACRD0)) W !?10,*7,"Batch COLOR NOT AVAILABLE FOR EXPORT -- Select AGAIN" G PROMPT
  1.  I $D(ACRNTRL(ACRD0)) D
  1.  . D NTRL
  1.  . W !!,*7,"All Batches MUST have a trailer -- JOB CANCELLED"
  1.  . S ACROUT=1
  1.  Q
  1. NTRL ;----- LISTS BATCHES WITH NO TRAILERS
  1.  ;
  1.  N ACRD0,ACRD1,ACRI,DIR,X,Y
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Batches exist w/o TRAILERS -- want to see a list"
  1.  S DIR("B")="YES"
  1.  D ^DIR
  1.  Q:'Y
  1.  S ACRD0=0
  1.  F  S ACRD0=$O(ACRNTRB(ACRD0)) Q:'ACRD0  D
  1.  . S ACRD1=0
  1.  . F  S ACRD1=$O(ACRNTRB(ACRD0,ACRD1)) Q:'ACRD1  D
  1.  . . S ACRI=""
  1.  . . F  S ACRI=$O(ACRNTRB(ACRD0,ACRD1,ACRI)) Q:ACRI']""  D
  1.  . . . W !?5,$$DATE(ACRD1)_"-"_ACRI
  1.  Q
  1. HDR ;----- WRITES MAIN OPTION HEADER
  1.  ;
  1.  D ^XBCLS
  1.  N I
  1.  S ACRPKG=$S(ACRCTR="PCC"!(ACRCTR="ARM"):"REGULAR FINANCE TRANSACTIONS",ACRCTR="BCS":"CHS CORRECTIONS TRANSACTIONS",1:"")
  1.  W !?18
  1.  F I=1:1:45 W "*"
  1.  W !?18,"*"
  1.  W ?22,"IHS AREA OFFICE DHR EXPORT (SPLITOUT)"
  1.  W ?62,"*"
  1.  W !?18,"*"
  1.  W ?26,ACRPKG
  1.  W ?62,"*"
  1.  W !?18,"*"
  1.  W ?34,"VERSION "
  1.  W $P($T(ACRFSPL1+1),";",3)
  1.  W ?62,"*"
  1.  W !?18
  1.  F I=1:1:45 W "*"
  1.  Q
  1. HDR1 ;----- WRITES HEADER 1
  1.  ;
  1.  N I
  1.  W !?5
  1.  F I=1:1:70 W "-"
  1.  W !?5,"*"
  1.  W ?15,"COLOR = BLUE"
  1.  W ?40,"*"
  1.  W ?56,"COLOR = RED"
  1.  W ?74,"*"
  1.  W !?5
  1.  F I=1:1:70 W "-"
  1.  Q
  1. HDR2 ;----- WRITES HEADER 2
  1.  ;
  1.  W !?5,"*"
  1.  W ?10,$S($G(ACRZ(1)):"COLOR AVAILABLE FOR EXPORT",1:"     NO DATA ON FILE")
  1.  W ?40,"*"
  1.  W ?45,$S($G(ACRZ(2)):"COLOR AVAILABLE FOR EXPORT",1:"     NO DATA ON FILE")
  1.  W ?74,"*"
  1.  W !?5
  1.  F I=1:1:70 W "-"
  1.  Q
  1. HDR3 ;----- WRITES HEADER 3
  1.  ;
  1.  W !,?6,"B. DATE  #BCH  ID'S  RCDS  NO-TR"
  1.  W ?40,"|"
  1.  W ?42,"B. DATE  #BCH  ID'S  RCDS  NO-TR"
  1.  W !?5
  1.  F I=1:1:70 W "-"
  1.  Q