- 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
