ACRFCHK ;IHS/OIRM/DSD/THL,AEF - CHECK FOR REQUIRED DATA DURING DOCUMENT DATA ENTRY; [ 09/23/2005 10:55 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**17,19**;NOV 05, 2001
;;ROUTINE CHECKS EACH REQUEST FOR INCLUSION OF REQUIRED DATA
FCHK ;EP;TO CHECK FOR REQUIRED DATA
;ACRREF MUST BE SET AS THE REFERENCE CODE FOR THE DOCUMENT
N ACRX,ACRI,ACRJ
D @ACRREF
EXIT D:$D(ACRI) FWARN
K ACRCHK,ACRJ,ACRI
Q
116 ;DATA CHECK FOR REQUISITIONS (393)
F ACRJ="FA","REQ","REQ1","DT","PO" S:'$D(^ACRDOC(ACRDOCDA,ACRJ)) ^ACRDOC(ACRDOCDA,ACRJ)=""
S:$P(^ACRDOC(ACRDOCDA,"FA"),U)="" ACRI(13)=""
F ACRJ=1:1:5,7,8,11 S:$P(^ACRDOC(ACRDOCDA,"REQ"),U,ACRJ)="" ACRI=$S(ACRJ=1:1,ACRJ=2:2,ACRJ=3:3,ACRJ=4:4,ACRJ=5:5,ACRJ=7:8,ACRJ=8:9,ACRJ=11:6),ACRI(ACRI)=""
S:$P(^ACRDOC(ACRDOCDA,"REQ1"),U)="" ACRI(10)="" S:$P(^ACRDOC(ACRDOCDA,0),U,14)="" ACRI(11)="" S:$P(^ACRDOC(ACRDOCDA,"DT"),U,4)="" ACRI(7)="" S:$P(^ACRDOC(ACRDOCDA,"REQ2"),U,8)="" ACRI(13)=""
Q
326 ;EP;DATA CHECK FOR TRIBAL CONTRACTS
349 ;EP;DATA CHECK FOR CONTRACTS
103 ;EP;DATA CHECK FOR PURCHASE ORDERS
204 ;EP;DATA CHECK FOR NOTICE MISC OBLIGATION ;ACR*2.1*17.03 IM16776
210 ;EP;DATA CHECK FOR FEDSTRIP
F ACRJ="PO","POIO","POST","POMI" S:'$D(^ACRDOC(ACRDOCDA,ACRJ)) ^ACRDOC(ACRDOCDA,ACRJ)=""
F ACRJ=1,22,5,6,7,12,17 S:$P(^ACRDOC(ACRDOCDA,"PO"),U,ACRJ)="" ACRI=$S(ACRJ=1:1,ACRJ=22:20,ACRJ=5:5,ACRJ=6:7,ACRJ=7:6,ACRJ=12:11,ACRJ=17:18),ACRI(ACRI)=""
S:$P(^ACRDOC(ACRDOCDA,"POIO"),U)="" ACRI(3)="" S:$P(^ACRDOC(ACRDOCDA,"POMI"),U)="" ACRI(16)="" S:$P(^ACRDOC(ACRDOCDA,"POST"),U)="" ACRI(4)=""
Q
130 ;DATA CHECK FOR TRAVEL ORDERS
S:$P(^ACRDOC(ACRDOCDA,"FA"),U)="" ACRI(30)="" S:$P(^ACRDOC(ACRDOCDA,"AU"),U)="" ACRI(27)=""
S:'$D(^ACRDOC(ACRDOCDA,"TO")) ^ACRDOC(ACRDOCDA,"TO")=""
F ACRJ=1,9,12:1:16 S:$P(^ACRDOC(ACRDOCDA,"TO"),U,ACRJ)="" ACRI=$S(ACRJ=1:1,ACRJ=9:3,ACRJ=12:4,ACRJ=13:5,ACRJ=14:6,ACRJ=15:7,ACRJ=16:26),ACRI(ACRI)=""
Q
148 ;DATA CHECK FOR TRAINING REQUESTS
S:$P(^ACRDOC(ACRDOCDA,"FA"),U)="" ACRI(29)="" S:$P(^ACRDOC(ACRDOCDA,"AU"),U)="" ACRI(28)=""
F ACRJ="TRNG","TRNG4" S:'$D(^ACRDOC(ACRDOCDA,ACRJ)) ^ACRDOC(ACRDOCDA,ACRJ)=""
F ACRJ=2,3,7,8,11,12,18,26 S:$P(^ACRDOC(ACRDOCDA,"TRNG"),U,ACRJ)="" ACRI=$S(ACRJ=2:1,ACRJ=3:2,ACRJ=7:3,ACRJ=8:4,ACRJ=11:7,ACRJ=12:8,ACRJ=18:9,ACRJ=26:23),ACRI(ACRI)=""
F ACRJ=1,3,4 S:$P(^ACRDOC(ACRDOCDA,"TRNG4"),U,ACRJ)="" ACRI=$S(ACRJ=1:24,ACRJ=2:25,ACRJ=3:26,ACRJ=4:27),ACRI(ACRI)=""
Q
600 ;
Q
23 ;DATA CHECK FOR PAYROLL ENTRIES
S:'$D(^ACRDOC(ACRDOCDA,"PR")) ^ACRDOC(ACRDOCDA,"PR")=""
S:$P(^ACRDOC(ACRDOCDA,"PR"),U)="" ACRI(1)=""
Q
FWARN ;ENTRY POINT CALLED WHEN MISSING DATA FOUND TO FORCE ENTRY
W *7,*7
W !
S ACRX="",ACRY=0
F S ACRY=$O(ACRI(ACRY)) Q:'ACRY S ACRX=ACRX_","_ACRY
S ACRX=$E(ACRX,2,99)
K ACRQUIT
D EN1^ACRFEA3
I ACRREF=130,$P(^ACRDOC(ACRDOCDA,"TO"),U,9),$P(^("TO"),U,22)<1 D
.S DA=ACRDOCDA
.S DIE="^ACRDOC("
.S DR="130157////"_+$P($G(^ACRAU(+$P(^ACRDOC(ACRDOCDA,"TO"),U,9),1)),U,6)
.D DIE^ACRFDIC
D:ACRREF=130!(ACRREF=148) IDEN
Q
IDEN ;EP;TO CREATE IDENTIFIER FOR REQUEST
Q:'$G(ACRDOCDA)
Q:$P($G(^ACRDOC(+ACRDOCDA,0)),U,14)]""
N ACRTO,ACRTRNG,ACRIDEN
S ACRTO=$G(^ACRDOC(ACRDOCDA,"TO")),ACRTRNG=$G(^ACRDOC(ACRDOCDA,"TRNG"))
S ACRIDEN=$S(ACRREF=130:$P(ACRTO,U,9),1:$P(ACRTRNG,U,2))
;S:$D(^VA(200,+ACRIDEN,0)) ACRIDEN=$S($P(^(0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U)) ;ACR*2.1*19.02 IM16848
S:$D(^VA(200,+ACRIDEN,0)) ACRIDEN=$S($P(^(0),U,2)]"":$P(^(0),U,2),1:$$NAME2^ACRFUTL1(+ACRIDEN)) ;ACR*2.1*19.02 IM16848
S:$L(ACRIDEN)>4 ACRIDEN=$E(ACRIDEN)_$E($P(ACRIDEN,",",2))
S ACRIDEN=ACRIDEN_"/"_$E($S(ACRREF=130:$P(ACRTO,U,14),1:$P(ACRTRNG,U,11)),4,7)_$S(ACRREF=148:"/"_$E($P(ACRTRNG,U,18),1,6),1:"")
S DIE="^ACRDOC(",DR=".14////"_ACRIDEN,DA=ACRDOCDA
D DIE^ACRFDIC
Q
ACRFCHK ;IHS/OIRM/DSD/THL,AEF - CHECK FOR REQUIRED DATA DURING DOCUMENT DATA ENTRY; [ 09/23/2005 10:55 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**17,19**;NOV 05, 2001
+2 ;;ROUTINE CHECKS EACH REQUEST FOR INCLUSION OF REQUIRED DATA
FCHK ;EP;TO CHECK FOR REQUIRED DATA
+1 ;ACRREF MUST BE SET AS THE REFERENCE CODE FOR THE DOCUMENT
+2 NEW ACRX,ACRI,ACRJ
+3 DO @ACRREF
EXIT IF $DATA(ACRI)
DO FWARN
+1 KILL ACRCHK,ACRJ,ACRI
+2 QUIT
116 ;DATA CHECK FOR REQUISITIONS (393)
+1 FOR ACRJ="FA","REQ","REQ1","DT","PO"
IF '$DATA(^ACRDOC(ACRDOCDA,ACRJ))
SET ^ACRDOC(ACRDOCDA,ACRJ)=""
+2 IF $PIECE(^ACRDOC(ACRDOCDA,"FA"),U)=""
SET ACRI(13)=""
+3 FOR ACRJ=1:1:5,7,8,11
IF $PIECE(^ACRDOC(ACRDOCDA,"REQ"),U,ACRJ)=""
SET ACRI=$SELECT(ACRJ=1:1,ACRJ=2:2,ACRJ=3:3,ACRJ=4:4,ACRJ=5:5,ACRJ=7:8,ACRJ=8:9,ACRJ=11:6)
SET ACRI(ACRI)=""
+4 IF $PIECE(^ACRDOC(ACRDOCDA,"REQ1"),U)=""
SET ACRI(10)=""
IF $PIECE(^ACRDOC(ACRDOCDA,0),U,14)=""
SET ACRI(11)=""
IF $PIECE(^ACRDOC(ACRDOCDA,"DT"),U,4)=""
SET ACRI(7)=""
IF $PIECE(^ACRDOC(ACRDOCDA,"REQ2"),U,8)=""
SET ACRI(13)=""
+5 QUIT
326 ;EP;DATA CHECK FOR TRIBAL CONTRACTS
349 ;EP;DATA CHECK FOR CONTRACTS
103 ;EP;DATA CHECK FOR PURCHASE ORDERS
204 ;EP;DATA CHECK FOR NOTICE MISC OBLIGATION ;ACR*2.1*17.03 IM16776
210 ;EP;DATA CHECK FOR FEDSTRIP
+1 FOR ACRJ="PO","POIO","POST","POMI"
IF '$DATA(^ACRDOC(ACRDOCDA,ACRJ))
SET ^ACRDOC(ACRDOCDA,ACRJ)=""
+2 FOR ACRJ=1,22,5,6,7,12,17
IF $PIECE(^ACRDOC(ACRDOCDA,"PO"),U,ACRJ)=""
SET ACRI=$SELECT(ACRJ=1:1,ACRJ=22:20,ACRJ=5:5,ACRJ=6:7,ACRJ=7:6,ACRJ=12:11,ACRJ=17:18)
SET ACRI(ACRI)=""
+3 IF $PIECE(^ACRDOC(ACRDOCDA,"POIO"),U)=""
SET ACRI(3)=""
IF $PIECE(^ACRDOC(ACRDOCDA,"POMI"),U)=""
SET ACRI(16)=""
IF $PIECE(^ACRDOC(ACRDOCDA,"POST"),U)=""
SET ACRI(4)=""
+4 QUIT
130 ;DATA CHECK FOR TRAVEL ORDERS
+1 IF $PIECE(^ACRDOC(ACRDOCDA,"FA"),U)=""
SET ACRI(30)=""
IF $PIECE(^ACRDOC(ACRDOCDA,"AU"),U)=""
SET ACRI(27)=""
+2 IF '$DATA(^ACRDOC(ACRDOCDA,"TO"))
SET ^ACRDOC(ACRDOCDA,"TO")=""
+3 FOR ACRJ=1,9,12:1:16
IF $PIECE(^ACRDOC(ACRDOCDA,"TO"),U,ACRJ)=""
SET ACRI=$SELECT(ACRJ=1:1,ACRJ=9:3,ACRJ=12:4,ACRJ=13:5,ACRJ=14:6,ACRJ=15:7,ACRJ=16:26)
SET ACRI(ACRI)=""
+4 QUIT
148 ;DATA CHECK FOR TRAINING REQUESTS
+1 IF $PIECE(^ACRDOC(ACRDOCDA,"FA"),U)=""
SET ACRI(29)=""
IF $PIECE(^ACRDOC(ACRDOCDA,"AU"),U)=""
SET ACRI(28)=""
+2 FOR ACRJ="TRNG","TRNG4"
IF '$DATA(^ACRDOC(ACRDOCDA,ACRJ))
SET ^ACRDOC(ACRDOCDA,ACRJ)=""
+3 FOR ACRJ=2,3,7,8,11,12,18,26
IF $PIECE(^ACRDOC(ACRDOCDA,"TRNG"),U,ACRJ)=""
SET ACRI=$SELECT(ACRJ=2:1,ACRJ=3:2,ACRJ=7:3,ACRJ=8:4,ACRJ=11:7,ACRJ=12:8,ACRJ=18:9,ACRJ=26:23)
SET ACRI(ACRI)=""
+4 FOR ACRJ=1,3,4
IF $PIECE(^ACRDOC(ACRDOCDA,"TRNG4"),U,ACRJ)=""
SET ACRI=$SELECT(ACRJ=1:24,ACRJ=2:25,ACRJ=3:26,ACRJ=4:27)
SET ACRI(ACRI)=""
+5 QUIT
600 ;
+1 QUIT
23 ;DATA CHECK FOR PAYROLL ENTRIES
+1 IF '$DATA(^ACRDOC(ACRDOCDA,"PR"))
SET ^ACRDOC(ACRDOCDA,"PR")=""
+2 IF $PIECE(^ACRDOC(ACRDOCDA,"PR"),U)=""
SET ACRI(1)=""
+3 QUIT
FWARN ;ENTRY POINT CALLED WHEN MISSING DATA FOUND TO FORCE ENTRY
+1 WRITE *7,*7
+2 WRITE !
+3 SET ACRX=""
SET ACRY=0
+4 FOR
SET ACRY=$ORDER(ACRI(ACRY))
IF 'ACRY
QUIT
SET ACRX=ACRX_","_ACRY
+5 SET ACRX=$EXTRACT(ACRX,2,99)
+6 KILL ACRQUIT
+7 DO EN1^ACRFEA3
+8 IF ACRREF=130
IF $PIECE(^ACRDOC(ACRDOCDA,"TO"),U,9)
IF $PIECE(^("TO"),U,22)<1
Begin DoDot:1
+9 SET DA=ACRDOCDA
+10 SET DIE="^ACRDOC("
+11 SET DR="130157////"_+$PIECE($GET(^ACRAU(+$PIECE(^ACRDOC(ACRDOCDA,"TO"),U,9),1)),U,6)
+12 DO DIE^ACRFDIC
End DoDot:1
+13 IF ACRREF=130!(ACRREF=148)
DO IDEN
+14 QUIT
IDEN ;EP;TO CREATE IDENTIFIER FOR REQUEST
+1 IF '$GET(ACRDOCDA)
QUIT
+2 IF $PIECE($GET(^ACRDOC(+ACRDOCDA,0)),U,14)]""
QUIT
+3 NEW ACRTO,ACRTRNG,ACRIDEN
+4 SET ACRTO=$GET(^ACRDOC(ACRDOCDA,"TO"))
SET ACRTRNG=$GET(^ACRDOC(ACRDOCDA,"TRNG"))
+5 SET ACRIDEN=$SELECT(ACRREF=130:$PIECE(ACRTO,U,9),1:$PIECE(ACRTRNG,U,2))
+6 ;S:$D(^VA(200,+ACRIDEN,0)) ACRIDEN=$S($P(^(0),U,2)]"":$P(^(0),U,2),1:$P(^(0),U)) ;ACR*2.1*19.02 IM16848
+7 ;ACR*2.1*19.02 IM16848
IF $DATA(^VA(200,+ACRIDEN,0))
SET ACRIDEN=$SELECT($PIECE(^(0),U,2)]"":$PIECE(^(0),U,2),1:$$NAME2^ACRFUTL1(+ACRIDEN))
+8 IF $LENGTH(ACRIDEN)>4
SET ACRIDEN=$EXTRACT(ACRIDEN)_$EXTRACT($PIECE(ACRIDEN,",",2))
+9 SET ACRIDEN=ACRIDEN_"/"_$EXTRACT($SELECT(ACRREF=130:$PIECE(ACRTO,U,14),1:$PIECE(ACRTRNG,U,11)),4,7)_$SELECT(ACRREF=148:"/"_$EXTRACT($PIECE(ACRTRNG,U,18),1,6),1:"")
+10 SET DIE="^ACRDOC("
SET DR=".14////"_ACRIDEN
SET DA=ACRDOCDA
+11 DO DIE^ACRFDIC
+12 QUIT
