- 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