ACRFDHR2 ;IHS/OIRM/DSD/THL,AEF - UTILITY TO SET X-REFS IN DHR FILE; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;CALL BY FILEMAN X-REFS
Q
SFYLOC(DA) ;EP;TO SET FY/LOCATION CODE XREF
Q:'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR10,U)=""
S ^ACRDHR("FYLOC",$P(ACR1,U,11),$P(ACR10,U),DA)=""
Q
KFYLOC(DA,X) ;EP;TO KILL FY/LOCATION CODE XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR10,U)=""
K ^ACRDHR("FYLOC",X,$P(ACR10,U),DA)
Q
KFYLOC2(DA,X) ;EP;TO KILL FY/LOCATION CODE XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
K ^ACRDHR("FYLOC",$P(ACR1,U,11),X,DA)
Q
SFYSSA(DA) ;EP;TO SET FY/SSA XREF
Q:'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR10,U,2)=""
S ^ACRDHR("FYSSA",$P(ACR1,U,11),$P(ACR10,U,2),DA)=""
Q
KFYSSA(DA,X) ;EP;TO KILL FY/SSA XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR10,U,2)=""
K ^ACRDHR("FYSSA",X,$P(ACR10,U,2),DA)
Q
KFYSSA2(DA,X) ;EP;TO KILL FY/SSA XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
K ^ACRDHR("FYSSA",$P(ACR1,U,11),X,DA)
Q
SFYCAN(DA) ;EP;TO SET FY/CAN XREF
Q:'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR1,U,12)=""
S ^ACRDHR("FYCAN",$P(ACR1,U,11),$P(ACR1,U,12),DA)=""
Q
KFYCAN(DA,X) ;EP;TO KILL FY/CAN XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,12)=""
K ^ACRDHR("FYCAN",X,$P(ACR1,U,12),DA)
Q
KFYCAN2(DA,X) ;EP;TO KILL FY/CAN XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
K ^ACRDHR("FYCAN",$P(ACR1,U,11),X,DA)
Q
SFYVND(DA) ;EP;TO SET FY/VND XREF
Q:'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR1,U,16)=""
S ^ACRDHR("FYVND",$P(ACR1,U,11),$P(ACR1,U,16),DA)=""
Q
KFYVND(DA,X) ;EP;TO KILL FY/VND XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,16)=""
K ^ACRDHR("FYVND",X,$P(ACR1,U,16),DA)
Q
KFYVND2(DA,X) ;EP;TO KILL FY/VND XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
K ^ACRDHR("FYVND",$P(ACR1,U,11),X,DA)
Q
SFYOCC(DA) ;EP;TO SET FY/OCC XREF
Q:'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR1,U,13)=""
S ^ACRDHR("FYOCC",$P(ACR1,U,11),$P(ACR1,U,13),DA)=""
Q
KFYOCC(DA,X) ;EP;TO KILL FY/OCC XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,13)=""
K ^ACRDHR("FYOCC",X,$P(ACR1,U,13),DA)
Q
KFYOCC2(DA,X) ;EP;TO KILL FY/OCC XREF
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
K ^ACRDHR("FYOCC",$P(ACR1,U,11),X,DA)
Q
S S ACR0=$G(^ACRDHR(DA,0))
S ACR1=$G(^ACRDHR(DA,1))
S ACR10=$G(^ACRDHR(DA,10))
Q
SFYLOCS(DA) ;EP;TO SET FY/LOCATION/SSA CODE XREF
Q:'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR10,U)=""
Q:$P(ACR10,U,2)=""
S ^ACRDHR("FYLOCSSA",$P(ACR1,U,11),$P(ACR10,U),$P(ACR10,U,2),DA)=""
Q
KFYLOCS(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR10,U)=""
Q:$P(ACR10,U,2)=""
K ^ACRDHR("FYLOCSSA",X,$P(ACR10,U),$P(ACR10,U,2),DA)
Q
KFYLOCS2(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR10,U,2)=""
K ^ACRDHR("FYLOCSSA",$P(ACR1,U,11),X,$P(ACR10,U,2),DA)
Q
KFYLOCS3(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR10,U)=""
K ^ACRDHR("FYLOCSSA",$P(ACR1,U,11),$P(ACR10,U),X,DA)
Q
SFYSSAL(DA) ;EP;TO SET FY/LOCATION/SSA CODE XREF
Q:'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR10,U)=""
Q:$P(ACR10,U,2)=""
S ^ACRDHR("FYSSALOC",$P(ACR1,U,11),$P(ACR10,U,2),$P(ACR10,U),DA)=""
Q
KFYSSAL(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR10,U)=""
Q:$P(ACR10,U,2)=""
K ^ACRDHR("FYSSALOC",X,$P(ACR10,U,2),$P(ACR10,U),DA)
Q
KFYSSAL2(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR10,U)=""
K ^ACRDHR("FYSSALOC",$P(ACR1,U,11),X,$P(ACR10,U),DA)
Q
KFYSSAL3(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
Q:X=""!(X[U)!'DA
N ACR0,ACR1,ACR10
D S
Q:$P(ACR1,U,11)=""
Q:$P(ACR10,U,2)=""
K ^ACRDHR("FYSSALOC",$P(ACR1,U,11),$P(ACR10,U,2),X,DA)
Q
ACRFDHR2 ;IHS/OIRM/DSD/THL,AEF - UTILITY TO SET X-REFS IN DHR FILE; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CALL BY FILEMAN X-REFS
+3 QUIT
SFYLOC(DA) ;EP;TO SET FY/LOCATION CODE XREF
+1 IF 'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR10,U)=""
QUIT
+6 SET ^ACRDHR("FYLOC",$PIECE(ACR1,U,11),$PIECE(ACR10,U),DA)=""
+7 QUIT
KFYLOC(DA,X) ;EP;TO KILL FY/LOCATION CODE XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR10,U)=""
QUIT
+5 KILL ^ACRDHR("FYLOC",X,$PIECE(ACR10,U),DA)
+6 QUIT
KFYLOC2(DA,X) ;EP;TO KILL FY/LOCATION CODE XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 KILL ^ACRDHR("FYLOC",$PIECE(ACR1,U,11),X,DA)
+6 QUIT
SFYSSA(DA) ;EP;TO SET FY/SSA XREF
+1 IF 'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR10,U,2)=""
QUIT
+6 SET ^ACRDHR("FYSSA",$PIECE(ACR1,U,11),$PIECE(ACR10,U,2),DA)=""
+7 QUIT
KFYSSA(DA,X) ;EP;TO KILL FY/SSA XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR10,U,2)=""
QUIT
+5 KILL ^ACRDHR("FYSSA",X,$PIECE(ACR10,U,2),DA)
+6 QUIT
KFYSSA2(DA,X) ;EP;TO KILL FY/SSA XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 KILL ^ACRDHR("FYSSA",$PIECE(ACR1,U,11),X,DA)
+6 QUIT
SFYCAN(DA) ;EP;TO SET FY/CAN XREF
+1 IF 'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR1,U,12)=""
QUIT
+6 SET ^ACRDHR("FYCAN",$PIECE(ACR1,U,11),$PIECE(ACR1,U,12),DA)=""
+7 QUIT
KFYCAN(DA,X) ;EP;TO KILL FY/CAN XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,12)=""
QUIT
+5 KILL ^ACRDHR("FYCAN",X,$PIECE(ACR1,U,12),DA)
+6 QUIT
KFYCAN2(DA,X) ;EP;TO KILL FY/CAN XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 KILL ^ACRDHR("FYCAN",$PIECE(ACR1,U,11),X,DA)
+6 QUIT
SFYVND(DA) ;EP;TO SET FY/VND XREF
+1 IF 'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR1,U,16)=""
QUIT
+6 SET ^ACRDHR("FYVND",$PIECE(ACR1,U,11),$PIECE(ACR1,U,16),DA)=""
+7 QUIT
KFYVND(DA,X) ;EP;TO KILL FY/VND XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,16)=""
QUIT
+5 KILL ^ACRDHR("FYVND",X,$PIECE(ACR1,U,16),DA)
+6 QUIT
KFYVND2(DA,X) ;EP;TO KILL FY/VND XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 KILL ^ACRDHR("FYVND",$PIECE(ACR1,U,11),X,DA)
+6 QUIT
SFYOCC(DA) ;EP;TO SET FY/OCC XREF
+1 IF 'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR1,U,13)=""
QUIT
+6 SET ^ACRDHR("FYOCC",$PIECE(ACR1,U,11),$PIECE(ACR1,U,13),DA)=""
+7 QUIT
KFYOCC(DA,X) ;EP;TO KILL FY/OCC XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,13)=""
QUIT
+5 KILL ^ACRDHR("FYOCC",X,$PIECE(ACR1,U,13),DA)
+6 QUIT
KFYOCC2(DA,X) ;EP;TO KILL FY/OCC XREF
+1 NEW ACR0,ACR1,ACR10
+2 DO S
+3 IF $PIECE(ACR1,U,11)=""
QUIT
+4 KILL ^ACRDHR("FYOCC",$PIECE(ACR1,U,11),X,DA)
+5 QUIT
S SET ACR0=$GET(^ACRDHR(DA,0))
+1 SET ACR1=$GET(^ACRDHR(DA,1))
+2 SET ACR10=$GET(^ACRDHR(DA,10))
+3 QUIT
SFYLOCS(DA) ;EP;TO SET FY/LOCATION/SSA CODE XREF
+1 IF 'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR10,U)=""
QUIT
+6 IF $PIECE(ACR10,U,2)=""
QUIT
+7 SET ^ACRDHR("FYLOCSSA",$PIECE(ACR1,U,11),$PIECE(ACR10,U),$PIECE(ACR10,U,2),DA)=""
+8 QUIT
KFYLOCS(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR10,U)=""
QUIT
+5 IF $PIECE(ACR10,U,2)=""
QUIT
+6 KILL ^ACRDHR("FYLOCSSA",X,$PIECE(ACR10,U),$PIECE(ACR10,U,2),DA)
+7 QUIT
KFYLOCS2(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR10,U,2)=""
QUIT
+6 KILL ^ACRDHR("FYLOCSSA",$PIECE(ACR1,U,11),X,$PIECE(ACR10,U,2),DA)
+7 QUIT
KFYLOCS3(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR10,U)=""
QUIT
+6 KILL ^ACRDHR("FYLOCSSA",$PIECE(ACR1,U,11),$PIECE(ACR10,U),X,DA)
+7 QUIT
SFYSSAL(DA) ;EP;TO SET FY/LOCATION/SSA CODE XREF
+1 IF 'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR10,U)=""
QUIT
+6 IF $PIECE(ACR10,U,2)=""
QUIT
+7 SET ^ACRDHR("FYSSALOC",$PIECE(ACR1,U,11),$PIECE(ACR10,U,2),$PIECE(ACR10,U),DA)=""
+8 QUIT
KFYSSAL(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR10,U)=""
QUIT
+5 IF $PIECE(ACR10,U,2)=""
QUIT
+6 KILL ^ACRDHR("FYSSALOC",X,$PIECE(ACR10,U,2),$PIECE(ACR10,U),DA)
+7 QUIT
KFYSSAL2(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR10,U)=""
QUIT
+6 KILL ^ACRDHR("FYSSALOC",$PIECE(ACR1,U,11),X,$PIECE(ACR10,U),DA)
+7 QUIT
KFYSSAL3(DA,X) ;EP;TO KILL FY/LOCATION/SSA CODE XREF
+1 IF X=""!(X[U)!'DA
QUIT
+2 NEW ACR0,ACR1,ACR10
+3 DO S
+4 IF $PIECE(ACR1,U,11)=""
QUIT
+5 IF $PIECE(ACR10,U,2)=""
QUIT
+6 KILL ^ACRDHR("FYSSALOC",$PIECE(ACR1,U,11),$PIECE(ACR10,U,2),X,DA)
+7 QUIT
