2009-12-04 00:11:15 -05:00
RACTOE2 ; ; 12 / 27 / 07
2009-11-29 13:37:14 -05:00
D DE G BEGIN
DE S DIE = "^RAO(75.1,D0," "M" "," , DIC = DIE , DP = 75.1125 , DL = 2 , DIEL = 1 , DU = "" K DG , DE , DB Q : $ O ( ^ RAO ( 75.1 , D0 , "M" , DA , "" ) ) = ""
I $ D ( ^ ( 0 ) ) S % Z = ^ ( 0 ) S % = $ P ( % Z , U , 1 ) S : % ] "" DE ( 1 ) = %
K % Z Q
;
W W ! ? DL + DL -2 , DLB_ ": "
Q
O D W W Y W : $ X > 45 ! ? 9
I $ L ( Y ) > 19 , ' DV , DV ' [ "I" , ( DV [ "F" ! ( DV [ "K" ) ) G RW ^ DIR2
W : Y ] "" "// " I ' DV , DV [ "I" , $ D ( DE ( DQ ) ) #2 S X = "" W " (No Editing)" Q
TR R X : DTIME E S ( DTOUT , X ) = U W $ C ( 7 )
Q
A K DQ ( DQ ) S DQ = DQ + 1
B G @ DQ
RE G PR : $ D ( DE ( DQ ) ) D W , TR
N I X = "" G NKEY : $ D ( ^ DD ( "KEY" , "F" , DP , DIFLD ) ) , A : DV ' [ "R" , X : ' DV , X : D ' > 0 , A
RD G QS : X ? . "?" I X [ "^" D D G ^ DIE17
I X = "@" D D G Z ^ DIE2
I X = " " , DV [ "d" , DV ' [ "P" , $ D ( ^ DISV ( DUZ , "DIE" , DLB ) ) S X = ^ ( DLB ) I DV ' [ "D" , DV ' [ "S" W " " _X
T G M ^ DIE17 : DV , ^ DIE3 : DV [ "V" , P : DV ' [ "S" X : $ D ( ^ DD ( DP , DIFLD , 12.1 ) ) ^ ( 12.1 ) I X ? . ANP D SET I ' DDER X : $ D ( DIC ( "S" ) ) DIC ( "S" ) I W : ' $ D ( DB ( DQ ) ) " " _ % G V
K DDER G X
P I DV [ "P" S DIC = U_DU , DIC ( 0 ) = $ E ( "EN" , $ D ( DB ( DQ ) ) + 1 ) _ "M" _ $ E ( "L" , DV ' [ "'" ) S : DIC ( 0 ) [ "L" DLAYGO = + $ P ( DV , "P" , 2 ) G : DV [ "*" AST ^ DIED D NOSCR ^ DIED S X = + Y , DIC = DIE G X : X < 0
G V : DV ' [ "N" D D I $ L ( $ P ( X , "." ) ) > 24 K X G Z
I $ P ( DQ ( DQ ) , U , 5 ) ' [ "$" , X ? .1 "-" . N .1 "." . N , $ P ( DQ ( DQ ) , U , 5 , 99 ) [ "+X'=X" S X = + X
V D @ ( "X" _DQ ) K YS
Z K DIC ( "S" ) , DLAYGO I $ D ( X ) , X ' = U D : $ G ( DE ( DW , "INDEX" ) ) SAVEVALS G : ' $ $ KEYCHK UNIQFERR ^ DIE17 S DG ( DW ) = X S : DV [ "d" ^ DISV ( DUZ , "DIE" , DLB ) = X G A
X W : ' $ D ( ZTQUEUED ) $ C ( 7 ) , "??" I $ D ( DB ( DQ ) ) G Z ^ DIE17
S X = "?BAD"
QS S DZ = X D D , QQ ^ DIEQ G B
D S D = DIFLD , DQ ( DQ ) = DLB_U _DV _U _DU _U _DW _U _ $ P ( $ T ( @ ( "X" _DQ ) ) , " " , 2 , 99 ) Q
Y I ' $ D ( DE ( DQ ) ) D O G RD : "@" ' [ X , A : DV ' [ "R" & ( X = "@" ) , X : X = "@" S X = Y G N
PR S DG = DV , Y = DE ( DQ ) , X = DU I $ D ( DQ ( DQ , 2 ) ) X DQ ( DQ , 2 ) G RP
R I DG [ "P" , @ ( "$D(^" _X _ "0))" ) S X = + $ P ( ^ ( 0 ) , U , 2 ) G RP : ' $ D ( ^ ( Y , 0 ) ) S Y = $ P ( ^ ( 0 ) , U ) , X = $ P ( ^ DD ( X , .01 , 0 ) , U , 3 ) , DG = $ P ( ^ ( 0 ) , U , 2 ) G R
I DG [ "V" , + Y , $ P ( Y , ";" , 2 ) [ "(" , $ D ( @ ( U_ $ P ( Y , ";" , 2 ) _ "0)" ) ) S X = + $ P ( ^ ( 0 ) , U , 2 ) G RP : ' $ D ( ^ ( + Y , 0 ) ) S Y = $ P ( ^ ( 0 ) , U ) I $ D ( ^ DD ( + X , .01 , 0 ) ) S DG = $ P ( ^ ( 0 ) , U , 2 ) , X = $ P ( ^ ( 0 ) , U , 3 ) G R
X : DG [ "D" ^ DD ( "DD" ) I DG [ "S" S % = $ P ( $ P ( ";" _X , ";" _Y _ ":" , 2 ) , ";" ) S : % ] "" Y = %
RP D O I X = "" S X = DE ( DQ ) G A : ' DV , A : DC < 2 , N ^ DIE17
I I DV ' [ "I" , DV ' [ "#" G RD
D E ^ DIE0 G RD : $ D ( X ) , PR
Q
SET N DIR S DIR ( 0 ) = "SV" _ $ E ( "o" , $ D ( DB ( DQ ) ) ) _U _DU , DIR ( "V" ) = 1
I $ D ( DB ( DQ ) ) , ' $ D ( DIQUIET ) N DIQUIET S DIQUIET = 1
D ^ DIR I ' DDER S % = Y ( 0 ) , X = Y
Q
SAVEVALS S @ DIEZTMP @ ( "V" , DP , DIIENS , DIFLD , "O" ) = $ G ( DE ( DQ ) ) S : $ D ( ^ ( "F" ) ) [ 0 ^ ( "F" ) = $ G ( DE ( DQ ) )
I $ D ( DE ( DW , "4/" ) ) S @ DIEZTMP @ ( "V" , DP , DIIENS , DIFLD , "4/" ) = ""
E K @ DIEZTMP @ ( "V" , DP , DIIENS , DIFLD , "4/" )
Q
NKEY W : ' $ D ( ZTQUEUED ) "?? Required key field" S X = "?BAD" G QS
KEYCHK ( ) Q : $ G ( DE ( DW , "KEY" ) ) = "" 1 Q @ DE ( DW , "KEY" )
BEGIN S DNM = "RACTOE2" , DQ = 1 + D G B
1 S DW = "0;1" , DV = "M*P71.2'X" , DU = "" , DLB = "PROCEDURE MODIFIERS" , DIFLD =. 01
S DE ( DW ) = "C1^RACTOE2"
S DU = "RAMIS(71.2,"
G RE : ' D S DQ = 2 G 2
C1 G C1S : $ D ( DE ( 1 ) ) [ 0 K DB
S X = DE ( 1 ) , DIC = DIE
K ^ RAO ( 75.1 , DA ( 1 ) , "M" , "B" , $ E ( X , 1 , 30 ) , DA )
C1S S X = "" G : DG ( DQ ) = X C1F1 K DB
S X = DG ( DQ ) , DIC = DIE
S ^ RAO ( 75.1 , DA ( 1 ) , "M" , "B" , $ E ( X , 1 , 30 ) , DA ) = ""
C1F1 Q
X1 S DIC ( "S" ) = "N RASERIES I +$D(^RAMIS(71.2," "AB" ",(+$$ITYPE^RASITE($$GET^RAPRI(D0))),+Y)),$S('$G(RASERIES):1,$P(^RAMIS(71.2,+Y,0),U,2)=" "" ":1,1:0)" D ^ DIC K DIC S DIC = DIE , X = + Y K : Y < 0 X
Q
;
2 G 1 ^ DIE17