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

ACRFDHRE.m

Go to the documentation of this file. 
  1. ACRFDHRE ;IHS/OIRM/DSD/AEF - DHR ENTER/EDIT [ 11/01/2001   9:44 AM ]
  1.  ;;2.1;ADMIN RESOURCE MGMT SYSTEM;;NOV 05, 2001
  1.  ;
  1.  ;
  1.  ;This routine contains subroutines used to enter/edit DHR data in the
  1.  ;DHR Data Records file.  The subroutines are called by the ACRFDHRD
  1.  ;routine.
  1.  ;
  1. OPT(ACROPT,ACROUT) ;EP
  1.  ;----- SELECT WHICH TYPE OF DHRS TO ENTER
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="SOM^ARMS:ARMS DHR VERIFY/MODIFY/CLOSE;DHRD:DHR DATA ENTRY;CHCS:CORRECTION DHR'S FOR CHS (FY)"
  1.  S DIR("A")="Select DATA ENTRY OPTION"
  1.  D ^DIR
  1.  I $D(DIRUT)!($D(DTOUT))!($D(DUOUT)) S ACROUT=1 Q
  1.  I Y="" S ACROUT=1 Q
  1.  S ACROPT=$S(Y="DHRD":"1^2",Y="CHCS":"3^4",Y="ARMS":"5^6",1:"")
  1.  I ACROPT="" S ACROUT=1
  1.  Q
  1. SEL(ACRD0,ACRD1,ACRD2,ACROUT,ACRADD,ACROPT,ACRCLR)         ;EP
  1.  ;----- SELECT BATCH
  1.  ;
  1. A ;
  1.  N Y
  1.  W !
  1.  D CLR(ACRADD,.Y,ACROPT,.ACROUT,.ACRCLR)
  1.  Q:$G(ACROUT)
  1.  S ACRD0=+Y
  1.  K Y
  1.  D DT(ACRD0,ACRADD,.Y,.ACROUT)
  1.  Q:$G(ACROUT)
  1.  S ACRD1=+Y
  1.  K Y
  1.  D ID(ACRD0,ACRD1,ACRADD,.Y,.ACROUT)
  1.  Q:$G(ACROUT)
  1.  S ACRD2=+Y
  1.  K Y
  1.  Q
  1. DUPE(ACRD0,ACRD1,ACRD2,ACRD3,ACRDUP,ACRDR)       ;EP
  1.  ;----- PICK FIELDS TO DUPLICATE
  1.  ;
  1.  N DATA,DIR,I,J,X,Y,Z
  1.  Q:'$D(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3))
  1.  I '$G(ACRDUP) D
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="Do you want to duplicate fields"
  1.  . S DIR("B")="NO"
  1.  I $G(ACRDUP) D
  1.  . S DIR(0)="Y"
  1.  . S DIR("A")="Want to keep duplicating"
  1.  . S DIR("B")="YES"
  1.  D ^DIR
  1.  S ACRDUP=+Y
  1.  K DIR,X,Y
  1.  I 'ACRDUP K ACRDR Q
  1.  Q:$G(ACRDR)]""
  1.  S DIR(0)="FO"
  1.  S DIR("A")="Enter FIELD NUMBERS (2-28) you want to duplicate"
  1.  S DIR("?")="Enter which fields to duplicate, i.e., 2-10 or 2,3,5,18"
  1.  D ^DIR
  1.  K DIR
  1.  Q:Y']""
  1.  S ACRDR=""
  1.  S DATA=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3,0)
  1.  F I=1:1:$L(Y,",") D
  1.  . S Z=$P(Y,",",I)
  1.  . I Z["-" D  Q
  1.  . . F J=$P(Z,"-"):1:$P(Z,"-",2) D
  1.  . . . Q:+J<2
  1.  . . . Q:+J>28
  1.  . . . S ACRDR=ACRDR_";"_J_"////"_$P(DATA,U,(J+1))
  1.  . Q:+Z<2
  1.  . Q:+Z>28
  1.  . S ACRDR=ACRDR_";"_Z_"////"_$P(DATA,U,(Z+1))
  1.  I $E(ACRDR)=";" S ACRDR=$E(ACRDR,2,999)
  1.  I ACRDR']"" K ACRDR
  1.  Q
  1. TYPE(Y) ;EP -- SELECT RECORD TYPE
  1.  ;
  1.  N DIR,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="SOM^2:BASIC TRANSACTION RECORD;3:CHANGE TRANSACTION RECORD;4:TRAILER RECORD;7:DFAFS RECORD;8:LOC(TRIBAL) TRANSACTION RECORD"
  1.  S DIR("A")="Select RECORD TYPE"
  1.  D ^DIR
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S Y=""
  1.  Q
  1. CLR(ACRADD,Y,ACROPT,ACROUT,ACRCLR)     ;
  1.  ;----- LOOKUP BATCH COLOR TYPE
  1.  ;
  1.  N DIC,DIR,DLAYGO,DTOUT,DUOUT,X
  1.  S DIC="^AFSHRCDS("
  1.  S DIC(0)=""
  1.  I $G(ACRCLR)']"" D
  1.  . S DIC(0)="AEMQ"
  1.  . S DIC("A")="Select BATCH TYPE/COLOR: "
  1.  I $G(ACRCLR)]"" D
  1.  . S X=$S(ACRCLR="B":$P(ACROPT,U),ACRCLR="R":$P(ACROPT,U,2),1:"")
  1.  . I X="" S ACROUT=1
  1.  Q:$G(ACROUT)
  1.  I $G(ACRADD) D
  1.  . S DIC(0)=DIC(0)_"L"
  1.  . S DLAYGO=9002322
  1.  D ^DIC
  1.  I $D(DTOUT)!($D(DUOUT)) S ACROUT=1
  1.  I Y'>0 S ACROUT=1
  1.  Q
  1. RB(ACRCLR)         ;EP
  1.  ;----- SELECT RED OR BLUE BATCH
  1.  ;
  1.  N DIR,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="SBOM^B:BLUE;R:RED"
  1.  S DIR("A")="Select COLOR"
  1.  D ^DIR
  1.  I $D(DTOUT)!($D(DUOUT))!($D(DIRUT)) S ACROUT=1 Q
  1.  I Y="" S ACROUT=1 Q
  1.  S ACRCLR=Y
  1.  Q
  1. DT(ACRD0,ACRADD,Y,ACROUT)    ;
  1.  ;----- LOOKUP BATCH DATE
  1.  ;
  1.  N DA,DIC,DLAYGO,DTOUT,DUOUT,X
  1.  S DA(1)=ACRD0
  1.  S DIC="^AFSHRCDS("_DA(1)_","_"""D"""_","
  1.  S DIC(0)="AEMQ"
  1.  I $G(ACRADD) S DIC(0)=DIC(0)_"L"
  1.  S DIC("A")="Select BATCH DATE: "
  1.  S DIC("P")=$P(^DD(9002322,1,0),U,2)
  1.  I $G(ACRADD) S DLAYGO=9002322
  1.  D ^DIC
  1.  I $D(DUOUT)!($D(DTOUT)) S ACROUT=1
  1.  I +Y'>0 S ACROUT=1
  1.  Q
  1. ID(ACRD0,ACRD1,ACRADD,Y,ACROUT)        ;
  1.  ;----- LOOKUP BATCH ID
  1.  ;
  1.  N DA,DIC,DLAYGO,DTOUT,DUOUT,X
  1.  S DA(1)=ACRD1
  1.  S DA(2)=ACRD0
  1.  S DIC="^AFSHRCDS("_DA(2)_","_"""D"""_","_DA(1)_","_"""I"""_","
  1.  S DIC(0)="AEMQ"
  1.  I $G(ACRADD) S DIC(0)=DIC(0)_"L"
  1.  S DIC("A")="Select BATCH ID: "
  1.  S DIC("DR")=1
  1.  S DIC("P")=$P(^DD(9002322.02,1,0),U,2)
  1.  I $G(ACRADD) S DLAYGO=9002322.02
  1.  D ^DIC
  1.  I $D(DUOUT)!($D(DTOUT)) S ACROUT=1
  1.  I +Y'>0 S ACROUT=1
  1.  Q
  1. SEQ(ACRD0,ACRD1,ACRD2,ACRDR,ACRADD,Y)  ;EP
  1.  ;----- LOOKUP BATCH SEQUENCE NUMBER
  1.  ;
  1.  N DA,DIC,DLAYGO,DTOUT,DUOUT,X
  1.  I '$D(ACRTYPE) S ACRTYPE=2 ;Do Need this with 650 DHR
  1.  S DA(1)=ACRD2
  1.  S DA(2)=ACRD1
  1.  S DA(3)=ACRD0
  1.  S DIC="^AFSHRCDS("_DA(3)_","_"""D"""_","_DA(2)_","_"""I"""_","_DA(1)_","_"""S"""_","
  1.  S DIC(0)="AEMQ"
  1.  I $G(ACRADD) S DIC(0)=DIC(0)_"L"
  1.  S DIC("A")="Select SEQUENCE NUMBER ('^' to exit): "
  1.  S X=$P($G(^AFSHRCDS(DA(3),"D",DA(2),"I",DA(1),"S",0)),U,3)
  1.  F X=X+1 Q:'$D(^AFSHRCDS(DA(3),"D",DA(2),"I",DA(1),"S",X))
  1.  S DIC("B")=X
  1.  K X
  1.  S DIC("DR")="1////"_ACRTYPE
  1.  I $D(ACRDR) S DIC("DR")=DIC("DR")_";"_ACRDR
  1.  S DIC("P")=$P(^DD(9002322.21,6,0),U,2)
  1.  I $G(ACRADD) S DLAYGO=9002322.21
  1.  D ^DIC
  1.  I $D(DUOUT)!($D(DTOUT)) S Y=""
  1.  Q
  1. EDIT(ACRD0,ACRD1,ACRD2,ACRD3,ACRTYPE,DDSPARM)    ;EP
  1.  ;----- EDIT SEQUENCE ENTRY
  1.  ;
  1.  N DA,DDSFILE,DR
  1.  S DA=ACRD3
  1.  S DA(1)=ACRD2
  1.  S DA(2)=ACRD1
  1.  S DA(3)=ACRD0
  1.  S DDSFILE=9002322
  1.  S DDSFILE(1)=9002322.216
  1.  S DR=$S(ACRTYPE=3:"[ACR DHR ENTRY 3]",1:"[ACR DHR ENTRY 2]")
  1.  D ^DDS
  1.  Q
  1.  ;
  1. DEL(ACRD0,ACRD1,ACRD2,ACRD3,ACRTYPE)   ;EP
  1.  ;----- CHECK AND DELETE INCOMPLETE DHR SEQUENCE ENTRY
  1.  ;
  1.  N DATA,DEL,I
  1.  S DEL=0
  1.  S DATA=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3,0)
  1.  I ACRTYPE=2 D
  1.  . F I=1:1:6,11:1:16 I $P(DATA,U,I)="" S DEL=1
  1.  I ACRTYPE=3 D
  1.  . F I=1,2,27 I $P(DATA,U,I)="" S DEL=1
  1.  I DEL D KILL(ACRD0,ACRD1,ACRD2,ACRD3)
  1.  Q
  1. KILL(ACRD0,ACRD1,ACRD2,ACRD3)          ;
  1.  ;----- DELETE DHR SEQUENCE ENTRY
  1.  ;
  1.  N DA,DIK
  1.  S DA(3)=ACRD0
  1.  S DA(2)=ACRD1
  1.  S DA(1)=ACRD2
  1.  S DA=ACRD3
  1.  S DIK="^AFSHRCDS("_DA(3)_","_"""D"""_","_DA(2)_","_"""I"""_","_DA(1)_","_"""S"""_","
  1.  D ^DIK
  1.  W *7,"     ",ACRD3,"    <DELETED>"
  1.  Q
  1. HDR(D0,D1,D2)      ;EP
  1.  ;----- WRITE RECORD HEADER
  1.  ;
  1.  N X,Z
  1.  I $G(D0)="" Q
  1.  I $G(D1)="" Q
  1.  I $G(D2)="" Q
  1.  S X="BID="
  1.  S Z=$P($G(^AFSHRCDS(D0,"D",D1,0)),U)
  1.  I Z S Z=$E(Z,4,5)_"/"_$E(Z,6,7)_"/"_($E(Z,1,3)+1700)
  1.  S X=X_Z_"-"_$P(^AFSHRCDS(D0,"D",D1,"I",D2,0),U)
  1.  S X=X_"       "
  1.  S Z=$P(^AFSHRCDS(D0,0),U)
  1.  S X=X_$S(Z=1!(Z=2):"PCC/HAS",Z=3!(Z=4):"CHS/FI",Z=5!(Z=6):"ARMS/HAS",1:"")
  1.  S X=X_" DHR    INPUT RECORD (DETAIL)       COLOR = "
  1.  S Z=$S(Z=1:"BLUE",Z=2:"RED",Z=3:"BLUE",Z=4:"RED",Z=5:"BLUE",Z=6:"RED",1:"")
  1.  S X=X_Z
  1.  Q X
  1. TRAIL(ACRD0,ACRD1,ACRD2)     ;EP
  1.  ;----- ADD TRAILER RECORD
  1.  ;      Don't need this subroutine with 650 character DHRs
  1.  ;
  1.  N AMT,CNT,DA,DATA,DIE,DIR,DR,X,Y
  1.  S (AMT,CNT,X)=0
  1.  F  S X=$O(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",X)) Q:'X  D
  1.  . S DATA=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",X,0)
  1.  . S CNT=CNT+1
  1.  . S AMT=AMT+$P(DATA,U,15)
  1.  W !,"TRAILER DATA:  RECORD COUNT = ",CNT,"    HASH DOLLARS = ",AMT
  1.  S DIR(0)="Y"
  1.  S DIR("A")="Is this correct"
  1.  S DIR("B")="NO"
  1.  D ^DIR
  1.  Q:'Y
  1.  S DA(2)=ACRD0
  1.  S DA(1)=ACRD1
  1.  S DA=ACRD2
  1.  S DIE="^AFSHRCDS("_DA(2)_","_"""D"""_","_DA(1)_","_"""I"""_","
  1.  S DR="2////CNT;4////"_CNT_";5////"_AMT
  1.  D ^DIE
  1.  W !,"TRAILER RECORD ADDED"
  1.  Q
  1. RO ;EP -- CALLED FROM REOPEN BATCH OPTION
  1.  ;
  1.  D HOME^%ZIS
  1.  D ^XBKVAR
  1.  S ACROUT=0
  1.  D DISPLAY^ACRFDHRD("1^6")
  1.  D SEL(.ACRD0,.ACRD1,.ACRD2,.ACROUT,0,"")
  1.  Q:$G(ACROUT)
  1.  I $P(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,0),U,3)'="C" D  G RO
  1.  . W !,"  Batch is already OPEN"
  1.  . H 2
  1.  D REOPEN(ACRD0,ACRD1,ACRD2)
  1.  G RO
  1.  Q
  1. REOPEN(ACRD0,ACRD1,ACRD2)    ;EP
  1.  ;----- REOPEN BATCH
  1.  ;
  1.  N DA,DIE,DIR,DR,Y
  1.  S DA(2)=ACRD0
  1.  S DA(1)=ACRD1
  1.  S DA=ACRD2
  1.  S DIE="^AFSHRCDS("_DA(2)_","_"""D"""_","_DA(1)_","_"""I"""_","
  1.  S DR="2////@;3////@;4////@;5////@;8////@"
  1.  D ^DIE
  1.  W !,"  Batch reopened"
  1.  Q
  1. DATE(X) ;EP -- FORMAT DATE
  1.  ;
  1.  ;      X = INTERNAL FILEMANAGER DATE IN YYYMMDD FORMAT
  1.  N Y
  1.  S Y=""
  1.  I X D
  1.  . Q:$L(X)'=7
  1.  . S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700)
  1.  Q Y
  1. ADDFMS(ACRD0,ACRD1,ACRD2,ACRD3,ACRSRC) ;EP
  1.  ;----- ADD ENTRY TO FMS DOCUMENT HISTORY RECORD FILE
  1.  ;      FROM DHR DATA RECORDS FILE
  1.  ;
  1.  N DA,DATA,DIC,DIE,DR,I,X,Y
  1.  Q:'$D(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3,0))
  1.  Q:$G(^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3,99))
  1.  S DATA=^AFSHRCDS(ACRD0,"D",ACRD1,"I",ACRD2,"S",ACRD3,0)
  1.  S X=$P(DATA,U,8)
  1.  I X']"" S X=$P(DATA,10)
  1.  Q:X']""
  1.  K DD,DO
  1.  S DIC="^ACRDHR("
  1.  S DIC(0)=""
  1.  D FILE^DICN
  1.  Q:+Y'>0
  1.  S (ACRFMS,DA)=+Y
  1.  S DIE=DIC
  1.  S DR=".02////"_DT_";.03////"_$G(DUZ)_";202////"_$G(ACRSRC)
  1.  S X=""
  1.  F I=1:1:14 S X=X_I_"////"_$P(DATA,U,I)_";"
  1.  I $E(X,$L(X))=";" S X=$E(X,1,$L(X)-1)
  1.  S DR(1,9002189.1,1)=X
  1.  S X=""
  1.  F I=15:1:28 S X=X_I_"////"_$P(DATA,U,I)_";"
  1.  I $E(X,$L(X))=";" S X=$E(X,1,$L(X)-1)
  1.  S DR(1,9002189.1,2)=X
  1.  D ^DIE
  1.  ;
  1.  K DR
  1.  S DA(3)=ACRD0
  1.  S DA(2)=ACRD1
  1.  S DA(1)=ACRD2
  1.  S DA=ACRD3
  1.  S DIE="^AFSHRCDS("_DA(3)_","_"""D"""_","_DA(2)_","_"""I"""_","_DA(1)_","_"""S"""_","
  1.  S DR="99////"_ACRFMS
  1.  D ^DIE
  1.  Q
  1.  ;----- LINK FROM DHR DATA RECORDS FILE TO FMS DOCUMENT HISTORY RECORD
  1.  ;      FILE
  1.  ;
  1.  ;      DA = IEN OF FMS DOCUMENT HISTORY RECORD FILE
  1.  ;      X1 = CORE TRANSMISSION DATE
  1.  ;      X3 = BATCH TYPE/COLOR
  1.  ;      X4 = BATCH DATE
  1.  ;      X5 = BATCH ID
  1.  ;      X6 = SEQUENCE NUMBER
  1.  ;      X7 = UNIX TRANSMISSION FILE NAME
  1.  ;
  1.  N D0,D1,D2,D3,DIE,DR,X,Y
  1.  Q:'DA
  1.  S DIE="^ACRDHR("
  1.  S DR="201////"_X1_";203////"_X3_";204////"_X4_";205////"_X5_";206////"_X6_";207////"_X7
  1.  D ^DIE
  1.  Q