%AUPTFXD ; BRJ/OHPD-TUCSON PROCESS DINUM=X VALUES [ 03/10/87 3:58 PM ]
;CALLED FROM ^%AUPTFXS
W !,*7,"%AUPTFXD cannot be run stand-alone. Please check your documentation!"
Q
;ENTRY POINT FROM ^%AUPTFXX
PUT ;PUT GLOBAL NODES AND VALUES OF -POINTING FILE- IN ^AUPTFXD
N AUPTPGM S AUPTPGM="<"_$T(+0)_">"
I '$D(^AUPTFXD(AUPTPSFL)) S ^(AUPTPSFL)=$P(AUPTDAL(-1),U,4) W !,AUPTPGM,?11,"Pointing field is .01 and DINUM=X.",!,?11,"Saving these changes in ^AUPTFXD.",!,?11,"Also, I must remove the old entries and cross references!",!,?11,"Please wait . . .",!,?11
I '$D(^(AUPTPSFL,AUPTPSFD)) S ^(AUPTPSFD)=$P(AUPTDAL(-1),U,6) S AUPTXGEN=0
S AUPTXGEN=AUPTXGEN+1
S ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"NEWX")=AUPTNEWX
S ^("OLDX")=AUPTOLDX,^("DA",0)=AUPTNEWX
I $D(DA(1)) S AUPTDAI=0 F L=0:0 S AUPTDAI=$O(DA(AUPTDAI)) Q:'+AUPTDAI S AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"DA",AUPTDAI)=DA(AUPTDAI)
D SVOLDNEW
S AUPTXGFM=$P(AUPTGNDE,",",1,(AUPTDACT*2-AUPTCOMA))_","
S AUPTXGTO=$S(AUPTDACT=1:AUPTORGG,1:$P(AUPTGNDE,",",1,(AUPTDACT*2-AUPTCOMA))_",")_AUPTNEWX_","
W "-X"
D FILEIT
S DIK=AUPTORGG D ^DIK
Q
SVOLDNEW ;SAVE OLD/NEW NODES AND VALUES FOR LATER DISPLAY
S ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"OLD","VAL")=@AUPTGNDE,^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"OLD","REF")=AUPTGNDE
S AUPTXGNW=@AUPTGNDE,$P(AUPTXGNW,U,AUPTP)=AUPTNEWX
S ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"NEW","VAL")=AUPTXGNW
S AUPTXGNW=$P($P(AUPTGNDE,"(",2),")",1)
S $P(AUPTXGNW,",",(AUPTDACT+(AUPTDACT-AUPTCOMA)))=AUPTNEWX
S AUPTXGNW=$P(AUPTGNDE,"(",1)_"("_AUPTXGNW_")"
S ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"NEW","REF")=AUPTXGNW
Q
FILEIT ;PUT GLOBAL NODE AND VALUE OF NEW 'DINUM=X' IN ^AUPTFXD
S AUPTXGNF=$L(AUPTXGFM,",")-1,AUPTXGNT=$L(AUPTXGTO,",")-1,AUPTXGLL=1,S1=""
S AUPTXGTF=AUPTXGFM F AUPTXGII=1:1:30 S AUPTXGTF=AUPTXGTF_"S"_AUPTXGII_","
S AUPTXGTT=AUPTXGTO F AUPTXGII=1:1:30 S AUPTXGTT=AUPTXGTT_"S"_AUPTXGII_","
S AUPTXGNE=0
F L=0:0 D BLDSS Q:AUPTXGLL=0
Q
BLDSS ;
S AUPTXGXX="S"_AUPTXGLL,AUPTXGYY=$P(AUPTXGTF,",",1,AUPTXGLL+AUPTXGNF)_")",@AUPTXGXX=$O(@AUPTXGYY)
I @AUPTXGXX'="" D:$D(@(AUPTXGYY))#2 DATAHIT S AUPTXGLL=AUPTXGLL+1,@("S"_AUPTXGLL)="" Q
S AUPTXGLL=AUPTXGLL-1
Q
DATAHIT ;
S AUPTXGZZ=$P(AUPTXGTT,",",1,AUPTXGLL+AUPTXGNT)_")"
S AUPTXGWK=$P($P(AUPTXGZZ,")",1),"(",2)
S AUPTXGGN=$P(AUPTXGZZ,"(",1)_"("
F L=0:0 Q:AUPTXGWK="" S AUPTXGWV=$P(AUPTXGWK,",",1) D FRAMEIT S AUPTXGGN=AUPTXGGN_AUPTXGWV,AUPTXGWK=$P(AUPTXGWK,",",2,99),AUPTXGGN=AUPTXGGN_$S(AUPTXGWK="":")",1:",")
S AUPTXGNE=AUPTXGNE+1
S ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"REF")=AUPTXGGN
S AUPTXGCK=@AUPTXGYY,^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"VAL")=AUPTXGCK
I AUPTXGCK=^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"OLD","VAL") S $P(^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"VAL"),U,AUPTP)=AUPTNEWX
Q
FRAMEIT ;DETERMINE NODE TYPE (NUMBER, ALPA'VARIABLE OR ALPHA&VARIABLE
I '+AUPTXGWV I $D(@AUPTXGWV) S AUPTXGWV=@AUPTXGWV
S AUPTXGWV=""""_AUPTXGWV_""""
Q
;ENTRY POINT FROM ^%AUPTFX
GET ;GET GLOBAL REFERENCES AND VALUES FROM ^AUPTFXD AND SET THEM
N AUPTPGM S AUPTPGM="<"_$T(+0)_">"
W !,?11,"Retrieving .01 DINUM=X actions stored in ^AUPTFXD.",!,?11,"Please wait. . .",!,?11
GETEN ;GET ENTRY NUMBER LEVEL OF ^AUPTFXD AND "DA" VALUES
S AUPTXGEN=""
F L=0:0 S AUPTXGEN=$O(^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN)) Q:'+AUPTXGEN S AUPTNEWX=^(AUPTXGEN,"NEWX") D GETDA,GETNODES
Q
GETDA ;RESTORE "DA" VALUES FOR ^DIK
S DA=^("DA",0)
S AUPTDAI=0 F L=0:0 S AUPTDAI=$O(^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"DA",AUPTDAI)) Q:'+AUPTDAI S DA(AUPTDAI)=^(AUPTDAI)
Q
GETNODES ;GET LAST NODE FOR POSTING DATA
S AUPTXGNE=""
F L=0:0 S AUPTXGNE=$O(^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE)) Q:'+AUPTXGNE S AUPTXGGN=^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"REF"),@AUPTXGGN=^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"VAL") D DSPXRCK
Q
DSPXRCK ;CHECK FOR DISPLAY AND FIRING XREFS AND TRIGGERS
W:'AUPTDSPY "-X"
D DSPLYIT:AUPTDSPY,RESETXR^AUPTFXX:$D(^DD(AUPTPSFL,AUPTPSFD,1,0))
Q
DSPLYIT ;DISPLAY OLD/NEW NODES AND VALUES
W !!,AUPTPGM,?11,"<OLD> ",^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"OLD","REF"),"=",^("VAL")
W !,?11,"<NEW> ",^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"NEW","REF"),"=",^("VAL")
Q
%AUPTFXD ; BRJ/OHPD-TUCSON PROCESS DINUM=X VALUES [ 03/10/87 3:58 PM ]
+1 ;CALLED FROM ^%AUPTFXS
+2 WRITE !,*7,"%AUPTFXD cannot be run stand-alone. Please check your documentation!"
+3 QUIT
+4 ;ENTRY POINT FROM ^%AUPTFXX
PUT ;PUT GLOBAL NODES AND VALUES OF -POINTING FILE- IN ^AUPTFXD
+1 NEW AUPTPGM
SET AUPTPGM="<"_$TEXT(+0)_">"
+2 IF '$DATA(^AUPTFXD(AUPTPSFL))
SET ^(AUPTPSFL)=$PIECE(AUPTDAL(-1),U,4)
WRITE !,AUPTPGM,?11,"Pointing field is .01 and DINUM=X.",!,?11,"Saving these changes in ^AUPTFXD.",!,?11,"Also, I must remove the old entries and cross references!",!,?11,"Please wait . . .",!,?11
+3 IF '$DATA(^(AUPTPSFL,AUPTPSFD))
SET ^(AUPTPSFD)=$PIECE(AUPTDAL(-1),U,6)
SET AUPTXGEN=0
+4 SET AUPTXGEN=AUPTXGEN+1
+5 SET ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"NEWX")=AUPTNEWX
+6 SET ^("OLDX")=AUPTOLDX
SET ^("DA",0)=AUPTNEWX
+7 IF $DATA(DA(1))
SET AUPTDAI=0
FOR L=0:0
SET AUPTDAI=$ORDER(DA(AUPTDAI))
IF '+AUPTDAI
QUIT
SET AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"DA",AUPTDAI)=DA(AUPTDAI)
+8 DO SVOLDNEW
+9 SET AUPTXGFM=$PIECE(AUPTGNDE,",",1,(AUPTDACT*2-AUPTCOMA))_","
+10 SET AUPTXGTO=$SELECT(AUPTDACT=1:AUPTORGG,1:$PIECE(AUPTGNDE,",",1,(AUPTDACT*2-AUPTCOMA))_",")_AUPTNEWX_","
+11 WRITE "-X"
+12 DO FILEIT
+13 SET DIK=AUPTORGG
DO ^DIK
+14 QUIT
SVOLDNEW ;SAVE OLD/NEW NODES AND VALUES FOR LATER DISPLAY
+1 SET ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"OLD","VAL")=@AUPTGNDE
SET ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"OLD","REF")=AUPTGNDE
+2 SET AUPTXGNW=@AUPTGNDE
SET $PIECE(AUPTXGNW,U,AUPTP)=AUPTNEWX
+3 SET ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"NEW","VAL")=AUPTXGNW
+4 SET AUPTXGNW=$PIECE($PIECE(AUPTGNDE,"(",2),")",1)
+5 SET $PIECE(AUPTXGNW,",",(AUPTDACT+(AUPTDACT-AUPTCOMA)))=AUPTNEWX
+6 SET AUPTXGNW=$PIECE(AUPTGNDE,"(",1)_"("_AUPTXGNW_")"
+7 SET ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"NEW","REF")=AUPTXGNW
+8 QUIT
FILEIT ;PUT GLOBAL NODE AND VALUE OF NEW 'DINUM=X' IN ^AUPTFXD
+1 SET AUPTXGNF=$LENGTH(AUPTXGFM,",")-1
SET AUPTXGNT=$LENGTH(AUPTXGTO,",")-1
SET AUPTXGLL=1
SET S1=""
+2 SET AUPTXGTF=AUPTXGFM
FOR AUPTXGII=1:1:30
SET AUPTXGTF=AUPTXGTF_"S"_AUPTXGII_","
+3 SET AUPTXGTT=AUPTXGTO
FOR AUPTXGII=1:1:30
SET AUPTXGTT=AUPTXGTT_"S"_AUPTXGII_","
+4 SET AUPTXGNE=0
+5 FOR L=0:0
DO BLDSS
IF AUPTXGLL=0
QUIT
+6 QUIT
BLDSS ;
+1 SET AUPTXGXX="S"_AUPTXGLL
SET AUPTXGYY=$PIECE(AUPTXGTF,",",1,AUPTXGLL+AUPTXGNF)_")"
SET @AUPTXGXX=$ORDER(@AUPTXGYY)
+2 IF @AUPTXGXX'=""
IF $DATA(@(AUPTXGYY))#2
DO DATAHIT
SET AUPTXGLL=AUPTXGLL+1
SET @("S"_AUPTXGLL)=""
QUIT
+3 SET AUPTXGLL=AUPTXGLL-1
+4 QUIT
DATAHIT ;
+1 SET AUPTXGZZ=$PIECE(AUPTXGTT,",",1,AUPTXGLL+AUPTXGNT)_")"
+2 SET AUPTXGWK=$PIECE($PIECE(AUPTXGZZ,")",1),"(",2)
+3 SET AUPTXGGN=$PIECE(AUPTXGZZ,"(",1)_"("
+4 FOR L=0:0
IF AUPTXGWK=""
QUIT
SET AUPTXGWV=$PIECE(AUPTXGWK,",",1)
DO FRAMEIT
SET AUPTXGGN=AUPTXGGN_AUPTXGWV
SET AUPTXGWK=$PIECE(AUPTXGWK,",",2,99)
SET AUPTXGGN=AUPTXGGN_$SELECT(AUPTXGWK="":")",1:",")
+5 SET AUPTXGNE=AUPTXGNE+1
+6 SET ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"REF")=AUPTXGGN
+7 SET AUPTXGCK=@AUPTXGYY
SET ^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"VAL")=AUPTXGCK
+8 IF AUPTXGCK=^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"OLD","VAL")
SET $PIECE(^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"VAL"),U,AUPTP)=AUPTNEWX
+9 QUIT
FRAMEIT ;DETERMINE NODE TYPE (NUMBER, ALPA'VARIABLE OR ALPHA&VARIABLE
+1 IF '+AUPTXGWV
IF $DATA(@AUPTXGWV)
SET AUPTXGWV=@AUPTXGWV
+2 SET AUPTXGWV=""""_AUPTXGWV_""""
+3 QUIT
+4 ;ENTRY POINT FROM ^%AUPTFX
GET ;GET GLOBAL REFERENCES AND VALUES FROM ^AUPTFXD AND SET THEM
+1 NEW AUPTPGM
SET AUPTPGM="<"_$TEXT(+0)_">"
+2 WRITE !,?11,"Retrieving .01 DINUM=X actions stored in ^AUPTFXD.",!,?11,"Please wait. . .",!,?11
GETEN ;GET ENTRY NUMBER LEVEL OF ^AUPTFXD AND "DA" VALUES
+1 SET AUPTXGEN=""
+2 FOR L=0:0
SET AUPTXGEN=$ORDER(^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN))
IF '+AUPTXGEN
QUIT
SET AUPTNEWX=^(AUPTXGEN,"NEWX")
DO GETDA
DO GETNODES
+3 QUIT
GETDA ;RESTORE "DA" VALUES FOR ^DIK
+1 SET DA=^("DA",0)
+2 SET AUPTDAI=0
FOR L=0:0
SET AUPTDAI=$ORDER(^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"DA",AUPTDAI))
IF '+AUPTDAI
QUIT
SET DA(AUPTDAI)=^(AUPTDAI)
+3 QUIT
GETNODES ;GET LAST NODE FOR POSTING DATA
+1 SET AUPTXGNE=""
+2 FOR L=0:0
SET AUPTXGNE=$ORDER(^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE))
IF '+AUPTXGNE
QUIT
SET AUPTXGGN=^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"REF")
SET @AUPTXGGN=^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,AUPTXGNE,"VAL")
DO DSPXRCK
+3 QUIT
DSPXRCK ;CHECK FOR DISPLAY AND FIRING XREFS AND TRIGGERS
+1 IF 'AUPTDSPY
WRITE "-X"
+2 IF AUPTDSPY
DO DSPLYIT
IF $DATA(^DD(AUPTPSFL,AUPTPSFD,1,0))
DO RESETXR^AUPTFXX
+3 QUIT
DSPLYIT ;DISPLAY OLD/NEW NODES AND VALUES
+1 WRITE !!,AUPTPGM,?11,"<OLD> ",^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"OLD","REF"),"=",^("VAL")
+2 WRITE !,?11,"<NEW> ",^AUPTFXD(AUPTPSFL,AUPTPSFD,AUPTXGEN,"NEW","REF"),"=",^("VAL")
+3 QUIT
