BCHFORM ; IHS/CMI/LAB - ASSIGN UNIQUE FORM # ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;
;Called from a cross reference in CHR Record.
;Generates next form # for a chr on a particular date.
;
EN ;EP - called from xbnew
S DIE="^BCHR(",DA=%,DR=".25///"_%1 D ^DIE
Q
SET1 ;EP - called form data dictionary cross reference
Q:$P(^BCHR(DA,0),U,3)=""
Q:$P(^BCHR(DA,0),U,2)=""
NEW %1 S (%,%1)="" F S %=$O(^BCHR("AF",$P(^BCHR(DA,0),U,3),$P(^(0),U,2),$P(X,"."),%)) Q:%'=+% S %1=%
;call xbnew
S %1=%1+1,%=DA
D ^XBNEW("EN^BCHFORM:%;%1")
Q
KILL1 ;EP
Q:$P(^BCHR(DA,0),U,3)=""
Q:$P(^BCHR(DA,0),U,2)=""
Q:$P(^BCHR(DA,0),U,25)=""
K ^BCHR("AF",$P(^BCHR(DA,0),U,3),$P(^(0),U,2),$P(X,"."),$P(^(0),U,25),DA)
Q
SET2 ;EP - called form data dictionary cross reference
Q:$P(^BCHR(DA,0),U,3)=""
Q:$P(^BCHR(DA,0),U)=""
NEW %1 S (%,%1)="" F S %=$O(^BCHR("AF",$P(^BCHR(DA,0),U,3),X,$P($P(^(0),U),"."),%)) Q:%'=+% S %1=%
;call xbnew
S %1=%1+1,%=DA
D ^XBNEW("EN^BCHFORM:%;%1")
Q
KILL2 ;EP
Q:$P(^BCHR(DA,0),U,3)=""
Q:$P(^BCHR(DA,0),U)=""
Q:$P(^BCHR(DA,0),U,25)=""
K ^BCHR("AF",$P(^BCHR(DA,0),U,3),X,$P($P(^(0),U),"."),$P(^(0),U,25),DA)
Q
SET3 ;EP - called form data dictionary cross reference
Q:$P(^BCHR(DA,0),U)=""
Q:$P(^BCHR(DA,0),U,2)=""
NEW %1 S (%,%1)="" F S %=$O(^BCHR("AF",X,$P(^BCHR(DA,0),U,2),$P($P(^(0),U),"."),%)) Q:%'=+% S %1=%
;call xbnew
S %1=%1+1,%=DA
D ^XBNEW("EN^BCHFORM:%;%1")
Q
KILL3 ;EP
Q:$P(^BCHR(DA,0),U)=""
Q:$P(^BCHR(DA,0),U,2)=""
Q:$P(^BCHR(DA,0),U,25)=""
K ^BCHR("AF",X,$P(^BCHR(DA,0),U,2),$P($P(^(0),U),"."),$P(^(0),U,25),DA)
Q
BCHFORM ; IHS/CMI/LAB - ASSIGN UNIQUE FORM # ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;
+3 ;Called from a cross reference in CHR Record.
+4 ;Generates next form # for a chr on a particular date.
+5 ;
EN ;EP - called from xbnew
+1 SET DIE="^BCHR("
SET DA=%
SET DR=".25///"_%1
DO ^DIE
+2 QUIT
SET1 ;EP - called form data dictionary cross reference
+1 IF $PIECE(^BCHR(DA,0),U,3)=""
QUIT
+2 IF $PIECE(^BCHR(DA,0),U,2)=""
QUIT
+3 NEW %1
SET (%,%1)=""
FOR
SET %=$ORDER(^BCHR("AF",$PIECE(^BCHR(DA,0),U,3),$PIECE(^(0),U,2),$PIECE(X,"."),%))
IF %'=+%
QUIT
SET %1=%
+4 ;call xbnew
+5 SET %1=%1+1
SET %=DA
+6 DO ^XBNEW("EN^BCHFORM:%;%1")
+7 QUIT
KILL1 ;EP
+1 IF $PIECE(^BCHR(DA,0),U,3)=""
QUIT
+2 IF $PIECE(^BCHR(DA,0),U,2)=""
QUIT
+3 IF $PIECE(^BCHR(DA,0),U,25)=""
QUIT
+4 KILL ^BCHR("AF",$PIECE(^BCHR(DA,0),U,3),$PIECE(^(0),U,2),$PIECE(X,"."),$PIECE(^(0),U,25),DA)
+5 QUIT
SET2 ;EP - called form data dictionary cross reference
+1 IF $PIECE(^BCHR(DA,0),U,3)=""
QUIT
+2 IF $PIECE(^BCHR(DA,0),U)=""
QUIT
+3 NEW %1
SET (%,%1)=""
FOR
SET %=$ORDER(^BCHR("AF",$PIECE(^BCHR(DA,0),U,3),X,$PIECE($PIECE(^(0),U),"."),%))
IF %'=+%
QUIT
SET %1=%
+4 ;call xbnew
+5 SET %1=%1+1
SET %=DA
+6 DO ^XBNEW("EN^BCHFORM:%;%1")
+7 QUIT
KILL2 ;EP
+1 IF $PIECE(^BCHR(DA,0),U,3)=""
QUIT
+2 IF $PIECE(^BCHR(DA,0),U)=""
QUIT
+3 IF $PIECE(^BCHR(DA,0),U,25)=""
QUIT
+4 KILL ^BCHR("AF",$PIECE(^BCHR(DA,0),U,3),X,$PIECE($PIECE(^(0),U),"."),$PIECE(^(0),U,25),DA)
+5 QUIT
SET3 ;EP - called form data dictionary cross reference
+1 IF $PIECE(^BCHR(DA,0),U)=""
QUIT
+2 IF $PIECE(^BCHR(DA,0),U,2)=""
QUIT
+3 NEW %1
SET (%,%1)=""
FOR
SET %=$ORDER(^BCHR("AF",X,$PIECE(^BCHR(DA,0),U,2),$PIECE($PIECE(^(0),U),"."),%))
IF %'=+%
QUIT
SET %1=%
+4 ;call xbnew
+5 SET %1=%1+1
SET %=DA
+6 DO ^XBNEW("EN^BCHFORM:%;%1")
+7 QUIT
KILL3 ;EP
+1 IF $PIECE(^BCHR(DA,0),U)=""
QUIT
+2 IF $PIECE(^BCHR(DA,0),U,2)=""
QUIT
+3 IF $PIECE(^BCHR(DA,0),U,25)=""
QUIT
+4 KILL ^BCHR("AF",X,$PIECE(^BCHR(DA,0),U,2),$PIECE($PIECE(^(0),U),"."),$PIECE(^(0),U,25),DA)
+5 QUIT
