Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHSPRE

ACHSPRE.m

Go to the documentation of this file. 
  1. ACHSPRE ;IHS/ITSC/PMF - ENVIRONMENT CHECK-NAMESPACE CLEANUP ;     [ 11/19/2001  8:18 AM ]
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
  1.  ;
  1.  S $ZT="ERROR"
  1.  S U="^",CM=","
  1.  ;
  1.  I 'XPDENV,$D(^ACHSINST) D
  1.  . M ^ACHSINS1=^ACHSINST
  1.  . S G="" F  S G=$O(^ACHSINST(G)) Q:G=""  K ^ACHSINST(G)
  1.  . Q
  1.  ;
  1.  S ^ACHSINST="",G=$$NOJOURN^ZIBGCHAR("ACHSINIT")
  1.  ;
  1.  S ACHSVERS="V"_$P($T(+2),";",3)
  1.  S $P(LINE,"*",81)=""
  1.  ;
  1.  I $D(^%ZOSF("MAXSIZ")) S X=250 X ^%ZOSF("MAXSIZ")
  1.  ;
  1.  ;GET THE CURRENT VERSION INSTALLED
  1.  S PACKNUM=$O(^DIC(9.4,"B",$P($T(+2),";",4),""))
  1.  I PACKNUM="" D  Q
  1.  .W !,$$C^XBFUNC("THERE IS SOMETHING WRONG WITH YOUR PACKAGE FILE!!")
  1.  .W !,$$C^XBFUNC("THE PACKAGE IEN COULD NOT BE FOUND IN FILE #9.4!")
  1.  .S XPDABORT=1
  1.  .D SORRY
  1.  ;
  1.  S CVERSION=$G(^DIC(9.4,PACKNUM,"VERSION"))
  1.  I CVERSION="" D  Q
  1.  .W !,"THERE IS SOMETHING WRONG WITH YOUR PACKAGE FILE!!"
  1.  .W !,"THE PACKAGE VERSION IN FILE #9.4 COULD NOT BE FOUND!"
  1.  .S XPDABORT=1
  1.  .D SORRY
  1.  ;
  1.  W !,"Checking, please wait..."
  1.  D INT^%SP
  1.  I %FTOTBLK/%TOTBLK*100<2 D  Q
  1.  . W !,"YOU HAVE LESS THAN 2% FREE SPACE.  THIS IS NOT ENOUGH SPACE TO DO THE INSTALL."
  1.  . S XPDABORT=1
  1.  . D SORRY
  1.  . Q
  1.  ;
  1.  W !,"More checking, please wait..."
  1.  S TOTBYT=0,GLOB="^ACHSDEN"
  1.  F  S GLOB=$Q(@GLOB) Q:GLOB=""  S TOTBYT=TOTBYT+$L(GLOB)+$L(@GLOB)
  1.  I TOTBYT*2.5/1012>%FTOTBLK D  Q
  1.  . W !,"YOU DO NOT HAVE ENOUGH FREE SPACE TO RUN THIS INSTALL."
  1.  . S XPDABORT=1
  1.  . D SORRY
  1.  . Q
  1.  ;
  1.  ;if we are doing the initial check prior to installing, it's time
  1.  ;to do the conversion
  1.  I 'XPDENV D CONV
  1.  I $G(STOP) D  Q
  1.  . W !,"THE TRIAL CONVERSION OF THE DENIAL DATA HAS FAILED"
  1.  . S XPDABORT=1 D SORRY
  1.  . Q
  1.  ;
  1.  I 'XPDENV W !!,"THE ENVIRONMENT CHECK WILL BE RUN WHEN THE INSTALL OPTION IS USED!" Q
  1.  ;
  1.  ;END of pre install check
  1.  ;
  1.  S XPDABORT=0
  1.  ;
  1.  I '$G(DUZ) W !,"DUZ UNDEFINED OR 0." S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"DUZ VARIABLES NOT SET")=NOW S XPDABORT=1 D SORRY Q
  1.  I '$L($G(DUZ(0))) W !,"DUZ(0) UNDEFINED OR NULL." S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"DUZ VARIABLES NOT SET")=NOW S XPDABORT=1 D SORRY Q
  1.  S INSTALER=$P($G(^VA(200,DUZ,0)),U)
  1.  I INSTALER="" S %H=$H D YX^%DTC S NOW=Y S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"UNKNOWN INSTALLER")=NOW S XPDABORT=1 D SORRY Q
  1.  ;
  1. ASKBACK ;
  1.  S DIR(0)="Y^^"
  1.  S DIR("A")="Has a SYSTEM BACKUP been successfully performed?"
  1.  S DIR("B")="NO"
  1.  S DIR("?")="Answer YES if backups were successfully performed."
  1.  D ^DIR
  1.  I $D(DUOUT) W !,"User initiated abort!",!,"Aborting installation!" S ERROR=1,XPDABORT=1 S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"USER INITIATED ABORT!")=NOW Q
  1.  I 'Y W !!,"Aborting installation!!" S ERROR=1,XPDABORT=1 S:Y="" ^ACHSINST(ACHSVERS,"ERROR",$ZN,"PROMPT TIMED OUT!")=NOW Q
  1. ASKCAPT ;
  1.  S DIR(0)="Y^^"
  1.  S DIR("A")="Has the 'Capture to file' option been turned on?"
  1.  S DIR("B")="NO"
  1.  S DIR("?")="Answer YES if the 'Capture to file' option is ON."
  1.  D ^DIR
  1.  I $D(DUOUT) W !,"User initiated abort!",!,"Aborting installation!!" S ERROR=1,XPDABORT=1 S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"USER INITIATED ABORT!")=NOW Q
  1.  I 'Y W !!,"Aborting installation!!" S ERROR=1,XPDABORT=1 S:Y="" ^ACHSINST(ACHSVERS,"ERROR",$ZN,"PROMPT TIMED OUT!")=NOW Q
  1.  ;
  1.  ;
  1.  D HOME^%ZIS,DT^DICRW
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"CHS INSTALL","STATUS","INSTALL BEGUN")=NOW
  1.  S ^ACHSINST(ACHSVERS,$ZN,"ENTERED")=NOW
  1.  W !,LINE
  1.  W !,$$C^XBFUNC("Hello, "_$P(INSTALER,CM,2)_" "_$P(INSTALER,CM)),!!,$$C^XBFUNC("Checking Environment for Installation of")
  1.  W !,$$C^XBFUNC("VERSION "_$P($T(+2),";",3)_" of "_$P($T(+2),";",4)_".")
  1.  S X=$G(^DD("VERSION"))
  1.  ;
  1.  W !!,"Need at least FileMan 21.....FileMan "_X_" Present"
  1.  I X<21 S ^ACHSINST(ACHSVERS,"ERROR","ONLY HAVE FILEMAN "_X)=NOW W "  Not Present!" D SORRY Q
  1.  S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XU",0)),"VERSION"))
  1.  W !!,"Need at least Kernel 7.1.....Kernel "_X_" Present"
  1.  I X<7.1 S ^ACHSINST(ACHSVERS,"ERROR","ONLY HAVE KERNEL "_X)=NOW W "  Not Present!" D SORRY Q
  1.  W !!,"Need HFS interface to Kernel (^%ZISH)....."
  1.  S ACHS=1
  1.  S ACHSRCHK="'$L($T(@X"_$S($G(^%ZOSF("OS"))["UNIX":"^%ZISH",1:"^ZISHMSMD")_"))"
  1.  F X="OPEN","DEL","SEND","LIST","STATUS" I @ACHSRCHK W !,$J("",20)_X_"^%ZISH not Present" S ACHS=0
  1.  I 'ACHS S ^ACHSINST(ACHSVERS,"ERROR","NEED HFS INTERFACE ^%ZISH ROUTINES")=NOW D SORRY Q
  1.  ;
  1.  S X=$G(^DIC(9.4,$O(^DIC(9.4,"C","XB",0)),"VERSION"))
  1.  W !!,"Need XB/ZIB, v 3.0.....XB/ZIB "_X_" Present"
  1.  I X<3 S ^ACHSINST(ACHSVERS,"ERROR","NEED XB/ZIB INSTALLED")=NOW W "  Not Present!" D SORRY Q
  1.  ;
  1.  S X=$P($T(+2^AUTTVLK),";",3)
  1.  S X=$S(X<89:"20"_X,1:"19"_X)
  1.  S X=$S(X>1998:"Looks OK...",1:"")
  1.  W !!,"Need AUT IHS Standard Data Dictionaries, at least v 98.1 ...."_X
  1.  I '$L(X) S ^ACHSINST(ACHSVERS,"ERROR","NEED AUTT VERSION 98.1")=NOW S XPDABORT=1 W "  Not OK!" D SORRY Q
  1.  S X=$P($T(+2^AUPNPAT),";",3)
  1.  S X=$S(X<89:"20"_X,1:"19"_X)
  1.  S X=$S(X>1999:"Looks OK...",1:"")
  1.  W !!,"Need AUPN, at least v 99.1 ...."_X
  1.  I '$L(X) S ^ACHSINST(ACHSVERS,"ERROR","NEED AUPN VERSION 99.1")=NOW S XPDABORT=1 W "  Not OK!" D SORRY Q
  1.  K ^TMP("ACHSPOST",$J)
  1.  ;
  1.  ;check conversion finished node
  1.  S RUNTIME="" F  S RUNTIME=$O(^ACHS("V3.1","denial conversion","AMOCK",RUNTIME)) Q:RUNTIME=""  I +$G(^(RUNTIME)) Q
  1.  ;
  1.  ;10/31/01  pmf  only check for the conversion if they are
  1.  ;not already 3.1. replace one line
  1.  ;I RUNTIME="" D  Q
  1.  I RUNTIME="",(CVERSION<3.1) D  Q
  1.  . W !!,"CONVERSION OF DENIAL DATA NOT FOUND"
  1.  . S ^ACHSINST(ACHSVERS,"ERROR","CONVERSION NOT COMPLETE"_X)=NOW D SORRY
  1.  . Q
  1.  ;
  1.  W !!,$$C^XBFUNC("ENVIRONMENT OK.")
  1.  W !,LINE
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,$ZN,"ENVIRONMENT CHECK OK")=NOW
  1.  ;
  1.  S %H=$H D YMD^%DTC
  1.  D DELDD
  1.  ;
  1.  W !!,"CHS DICTIONARIES FROM PREVIOUS VERSION HAVE BEEN DELETED!"
  1.  D DELRTN
  1.  S ^ACHSINST(ACHSVERS,$ZN,"CHS NAMESPACE DELETIONS FINISHED")=NOW
  1.  W !!,"CHS ROUTINES FROM PREVIOUS VERSION HAVE BEEN DELETED!"
  1.  W !!,LINE
  1.  K ^TMP("ACHSPOST")
  1.  Q
  1.  ;
  1. SORRY ;
  1.  K DIFQ
  1.  W *7,!!!,$$C^XBFUNC("Sorry....something is wrong with your environment")
  1.  W !,$$C^XBFUNC("Aborting Contract Health System install!")
  1.  W !,$$C^XBFUNC("Please print/capture this screen and notify")
  1.  W !,$$C^XBFUNC("the Support Team")
  1.  W !!,LINE
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S XPDABORT=1
  1.  ;
  1.  S ^ACHSINST(ACHSVERS,$ZN,"ENVIRONMENT CHECK FAILED")=NOW
  1.  S ^ACHSINST(ACHSVERS,$ZN,"ABORTED")=NOW
  1.  ;
  1.  S Y=$$DIR^XBDIR("E","Press RETURN To Continue...","","","",1) X ^%ZOSF("TRMRD")
  1.  Q
  1.  ;
  1. DELRTN ;
  1.  S XPDIDTOT=384,XPDIDVT=10,XGCURATR=10,IOBM=10
  1.  D INIT^XPDID
  1.  D TITLE^XPDID("DELETING OLD CHS ROUTINES")
  1.  D SAY^XGF(10,10,"DELETING CHS ROUTINES.....")
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DELRTN^"_$ZN,"ENTERED")=NOW
  1.  S %RN="ACHRZZZ" F COUNT=1:1 S %RN=$O(^(%RN)) Q:%RN'[("ACH")&(%RN'[("AZZZE"))  D
  1.  .S $P(FILLER," ",IOM-$L(%RN))=""
  1.  .D SAY^XGF(12,10,"DELETING "_%RN_"....."_FILLER)
  1.  .X "ZR  ZS @%RN"
  1.  .D UPDATE^XPDID(COUNT)
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DELRTN^"_$ZN,"FINISHED")=NOW
  1.  D UPDATE^XPDID(0)
  1.  D EXIT^XPDID("FINISHED WITH CHS ROUTINE DELETE!")
  1.  Q
  1.  ;
  1. DELDD ;
  1.  S XPDIDTOT=20,XPDIDVT=10,XGCURATR=10,IOBM=10
  1.  D INIT^XPDID,TITLE^XPDID("DELETING OLD CHS DATA DICTIONARIES")
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DELDD^"_$ZN,"ENTERED")=NOW
  1.  F GLO="^DIC(","^DD(" D
  1.  .S FILENUM=9002060.999999
  1.  .F COUNT=1:1  S FILENUM=$O(@(GLO_FILENUM_")")) Q:FILENUM>9002080.999999  D
  1.  ..S GLOBAL=GLO_FILENUM_")"
  1.  ..I '$D(@GLOBAL) D SAY^XGF(12,10,GLOBAL_" NOT FOUND ON THIS SYSTEM!") Q
  1.  ..D UPDATE^XPDID(COUNT)
  1.  ..D SAY^XGF(12,10,"KILLING GLOBAL "_GLOBAL_"  ..........")
  1.  ..K @GLOBAL
  1.  S TMP=$O(^DIC("B","CHS DEFERRED SERVICES CATEGORY",""))
  1.  K:TMP=9002068 ^DIC("B","CHS DEFERRED SERVICES CATEGORY",9002068)
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"DELDD^"_$ZN,"FINISHED")=NOW
  1.  D UPDATE^XPDID(0)
  1.  D EXIT^XPDID("FINISHED WITH CHS DATA DICTIONARY DELETE!")
  1.  Q
  1.  ;
  1. CONV ; CONVERT CHS DENIAL DATA FROM OLD TO NEW STRUCTURE
  1.  ;
  1.  S %H=$H D YX^%DTC S NOW=Y,RUNTIME=Y
  1.  I '$G(CVERSION) S ^ACHSINST(ACHSVERS,$ZN,"CONVERSION NOT DONE, FIRST TIME INSTALL")=NOW Q
  1.  ;
  1.  I +CVERSION>3 W !!,"THE CURRENT VERSION OF CHS IS HIGER THAN 3.0",!,"CONVERSION PROCESS WILL BE BYPASSED!" S ^ACHSINST(ACHSVERS,$ZN,"CONVERSION BYPASSED DUE TO HIGH VERSION")=NOW Q
  1.  ;
  1.  S LINE=$G(LINE)
  1.  W !!,LINE,!!,"Starting trial conversion, please be patient"
  1.  S ^ACHSINST(ACHSVERS,"CONV^"_$ZN,"ENTERED")=NOW
  1.  ;
  1.  S (NUMENTRY,NUMERR,STOP)=0,QT=""""
  1.  ;
  1.  ;S NODE=$G(^ACHSINST(VERS,"CONVERSION",MOCK,"LAST NODE"))
  1.  S NODE=""
  1.  I NODE="" S NODE="^ACHSDEN"
  1.  ;
  1.  ;stop journaling on the globals, if they exist
  1.  S G=$$NOJOURN^ZIBGCHAR("ACHSDEN")
  1.  I $D(^ACHSDENY) S G=$$NOJOURN^ZIBGCHAR("ACHSDENY")
  1.  I $D(^ACHSDENZ) S G=$$NOJOURN^ZIBGCHAR("ACHSDENZ")
  1.  ;
  1.  ;kill off globals one and two, just in case they exist
  1.  S G="" F  S G=$O(^ACHSDENY(G)) Q:G=""  K ^(G)
  1.  S G="" F  S G=$O(^ACHSDENZ(G)) Q:G=""  K ^(G)
  1.  ;
  1.  ;establish top node of globals one and two
  1.  S ^ACHSDENY="",^ACHSDENZ=""
  1.  ;stop journaling on the globals again, now that we know they exist
  1.  S G=$$NOJOURN^ZIBGCHAR("ACHSDEN"),G=$$NOJOURN^ZIBGCHAR("ACHSDENY"),G=$$NOJOURN^ZIBGCHAR("ACHSDENZ")
  1.  ;
  1.  M ^ACHSDENZ=^ACHSDEN
  1.  S NEWNODE="^ACHSDENY("
  1.  ;
  1.  D LOOP1
  1.  I 'STOP D SET1
  1.  I 'STOP D LOOP2
  1.  ;
  1.  S %H=$H D YX^%DTC
  1.  S ^ACHS("V3.1","denial conversion","AMOCK",RUNTIME)='STOP_U_Y
  1.  ;
  1.  S %H=$H D YX^%DTC S NOW=Y
  1.  S ^ACHSINST(ACHSVERS,"CONV^"_$ZN,"FINISHED")=NOW
  1.  ;
  1.  Q
  1.  ;
  1. LOOP1 ;
  1.  S $ZT="ERRORCN"
  1.  ;
  1.  F  S NODE=$Q(@NODE) Q:NODE=""!(STOP)  D
  1.  . ;
  1.  . ;SKIP X-REFS WE DO NOT NEED TO CONVERT THESE.
  1.  . S FIRSTSUB=$P($P(NODE,CM),"(",2)
  1.  . I FIRSTSUB?1""""1A.E1"""" Q
  1.  . ;
  1.  . ;check for alpha subscripts, indicating a cross reference
  1.  . ;do not process these
  1.  . S FOUND=0 F XXI=3:1:99 S XXS=$P($P(NODE,"(",2),CM,XXI) Q:XXS=""  I XXS?1""""1A.E1"""" S FOUND=1 Q
  1.  . K XXI,XXS I FOUND Q
  1.  . K FOUND
  1.  . ;CHECK FOR NEW DATA STRUCTURE MIXED WITH OLD, copy new data as is
  1.  . I NODE[("""D""") D ASIS Q
  1.  . I NODE[(",0)"),$L(NODE,CM)=2 D REC0 Q
  1.  . I NODE[(",10)") D REC10 Q
  1.  . I NODE[(",100)") D REC100 Q
  1.  . I NODE[(",200,") D REC200 Q
  1.  . I NODE[(",210,") D REC210 Q
  1.  . I NODE[(",290)") D REC290 Q
  1.  . I NODE[(",300,") D REC300 Q
  1.  . I NODE[(",400)") D REC400 Q
  1.  . I NODE[(",500,") D REC500 Q
  1.  . I NODE[(",600,") D REC600 Q
  1.  . I NODE[(",650)") D REC650 Q
  1.  . I NODE[(",700,") D REC700 Q
  1.  . Q
  1.  ;
  1.  ;that ends the main loop of the conversion
  1.  Q
  1.  ;
  1. SET1 ;
  1.  S NEWNODE="^ACHSDENY(0)"
  1.  S @NEWNODE="CHS DENIAL DATA^9002071I"_U_$S($G(ISSUEFAC)="":0,1:ISSUEFAC)_U_$S($G(NUMENTRY)="":0,1:NUMENTRY)
  1.  ;
  1.  ;DO COUNTS OF FACILITIES AND ITEMS WITHIN FACILITY
  1.  S FAC=0 F CNT=1:1 S FAC=$O(^ACHSDENY(FAC)) Q:+FAC=0  D
  1.  . S ITEM=0 F CNT2=1:1 S ITEM=$O(^ACHSDENY(FAC,"D",ITEM)) Q:+ITEM=0  D
  1.  .. S NEWNODE="^ACHSDENY("_FAC_CM_QT_"D"_QT_CM_"0)"
  1.  .. S @NEWNODE=U_"9002071.01A"_U_ITEM_U_CNT2
  1.  .. Q
  1.  . Q
  1.  ;
  1.  Q
  1.  ;
  1. LOOP2 ;
  1.  ;the data is now converted and sitting in ^ACHSDENY.
  1.  ;here we set up the cross references for it.
  1.  W !!!,"Re-indexing new Denial file..."
  1.  ;
  1.  S FAC=0 F  S FAC=$O(^ACHSDENY(FAC)) Q:'+FAC  Q:STOP  S DEN=0 D LOOP2A
  1.  Q
  1.  ;
  1. LOOP2A ;
  1.  ;note start of new error trap
  1.  S $ZT="ERRORXR"
  1.  ;
  1.  F  S DEN=$O(^ACHSDENY(FAC,"D",DEN)) Q:'+DEN  Q:STOP  D
  1.  . S DAT=$G(^ACHSDENY(FAC,"D",DEN,0))
  1.  . I DAT="" Q
  1.  . S NODE="^ACHSDENY("_FAC_CM_QT_"D"_QT_CM_DEN
  1.  . S DENIAL=$P(DAT,U,1),AISSUE=$P(DAT,U,2),ES=$P(DAT,U,4)
  1.  . I AISSUE'="" S ^ACHSDENY(FAC,"D","AISSUE",AISSUE,DEN)=""
  1.  . I DENIAL'="" S ^ACHSDENY(FAC,"D","B",DENIAL,DEN)=""
  1.  . I ES'="" S ^ACHSDENY(FAC,"D","ES",ES,DEN)=""
  1.  . Q
  1.  Q
  1.  ;
  1.  W !,"Denial Updates Completed at ",$$FMTE^XLFDT(%)
  1.  S ^ACHSINST(ACHSVERS,"REINDEX^"_$ZN,"FINISHED")=NOW
  1.  ;
  1.  Q
  1.  ;
  1. ASIS ;
  1.  ;COPY AS IS THIS IS THE NEW DATA STRUCTURE
  1.  S RECORD=$G(@NODE)
  1.  S SUB1=$P(NODE,"(",2,299)
  1.  S ASISNODE="^ACHSDEN("_SUB1
  1.  S @ASISNODE=RECORD
  1.  ;
  1.  Q
  1.  ;
  1. REC0 ;
  1.  ;GET THE ZERO NODE AND REARRANGE THE PIECES
  1.  S NUMENTRY=NUMENTRY+1
  1.  I NUMENTRY#100=0 W !,?18,NUMENTRY," denials examined so far"
  1.  S REC0=$G(@NODE)
  1.  S DENIAL=$P(REC0,U)
  1.  S ISSUEDT=$P(REC0,U,2)
  1.  S SERVDT=$P(REC0,U,3)
  1.  S ISREG=$P(REC0,U,4)
  1.  S PAT=$P(REC0,U,5)
  1.  S ISSUEBY=$P(REC0,U,6)
  1.  S REQDT=$P(REC0,U,7)
  1.  S ISSUEFAC=$P(REC0,U,8)
  1.  ;
  1.  I ISSUEFAC="" S ISSUEFAC=$O(^ACHSF("B",0))
  1.  ;
  1.  S ENTRYNUM=$P($P(NODE,","),"(",2)
  1.  ;
  1.  ;CHECK FOR EXISTING ENTRIES HERE (THIS SHOULD ONLY HAPPEN IN SITES WITH
  1.  ;THE OLD STRUCTURE MIXED WITH THE NEW)
  1.  I $D(^ACHSDEN(ISSUEFAC,"D",ENTRYNUM)) W !,"ENTRY "_ENTRYNUM_" ALREADY EXISTS FOR THIS "_ISSUEFAC_"!" S ENTRYNUM=$O(^ACHSDEN(ISSUEFAC,"D","A"),-1)+1
  1.  ;
  1.  S NEWNODE="^ACHSDENY("_ISSUEFAC
  1.  ;
  1.  S @(NEWNODE_",0)")=ISSUEFAC
  1.  S NODE0=NEWNODE_",""D"","_ENTRYNUM_",0)"
  1.  S @NODE0=DENIAL_U_ISSUEDT_U_ISSUEBY_U_SERVDT_U_REQDT_U_ISREG_U_PAT
  1.  ;
  1.  Q
  1. REC10 ;EP
  1.  S REC10=$G(@NODE)     ;NO CHANGE IN PIECES
  1.  S NODE10=NEWNODE_",""D"","_ENTRYNUM_",10)"
  1.  S @NODE10=REC10
  1.  Q
  1. REC100 ;EP
  1.  S REC100=$G(@NODE)   ;NO CHANGE IN PIECES
  1.  S NODE100=NEWNODE_",""D"","_ENTRYNUM_",100)"
  1.  S @NODE100=REC100
  1.  Q
  1. REC200 ;EP
  1.  S REC200=$G(@NODE)
  1.  I $P(REC200,U,2)="9002071.01PA" S $P(REC200,U,2)="9002071.02PA"
  1.  S NODE200=NEWNODE_",""D"","_ENTRYNUM_",200"_$S(ENTRYNUM=200:$P(NODE,"200,200",2,99),1:$P(NODE,",200",2,99))
  1.  S @NODE200=REC200
  1.  Q
  1. REC210 ;EP
  1.  S REC210=$G(@NODE)   ;NO CHANGE IN PIECES
  1.  I $P(REC210,U,2)="9002071.05A" S $P(REC210,U,2)="9002071.03A"
  1.  S NODE210=NEWNODE_",""D"","_ENTRYNUM_",210"_$S(ENTRYNUM=210:$P(NODE,"210,210",2,99),1:$P(NODE,",210",2,99))
  1.  S @NODE210=REC210
  1.  Q
  1. REC290 ;EP
  1.  S REC290=$G(@NODE)   ;CHANGE TO NODE 250 SAME PIECE
  1.  S NODE250=NEWNODE_",""D"","_ENTRYNUM_",250)"
  1.  S @NODE250=REC290
  1.  Q
  1. REC300 ;EP
  1.  S REC300=$G(@NODE)     ;NO CHANGE IN PIECES
  1.  I $P(REC300,U,2)="9002071.02PA" S $P(REC300,U,2)="9002071.04PA"
  1.  S NODE300=NEWNODE_",""D"","_ENTRYNUM_",300"_$S(ENTRYNUM=300:$P(NODE,"300,300",2,99),1:$P(NODE,",300",2,99))
  1.  S @NODE300=REC300
  1.  Q
  1. REC400 ;EP
  1.  S REC400=$G(@NODE)     ;PIECES CHANGE
  1.  S DEFSER=$P(REC400,U)
  1.  S PRICAT=$P(REC400,U,4)
  1.  S MPRICAT=""
  1.  S:PRICAT'="" MPRICAT=$O(^ACHSMPRI("B",PRICAT,MPRICAT))
  1.  S APPEAL=$P(REC400,U,5)
  1.  S NREC400=DEFSER_U_MPRICAT_U_APPEAL
  1.  S NODE400=NEWNODE_",""D"","_ENTRYNUM_",400)"
  1.  S @NODE400=NREC400
  1.  Q
  1. REC500 ;EP
  1.  S REC500=$G(@NODE)
  1.  I $P(REC500,U,2)="9002071.03PA" S $P(REC500,U,2)="9002071.05PA"
  1.  S NODE500=NEWNODE_",""D"","_ENTRYNUM_",500"_$S(ENTRYNUM=500:$P(NODE,"500,500",2,99),1:$P(NODE,",500",2,99))
  1.  S @NODE500=REC500
  1.  Q
  1. REC600 ;EP
  1.  S REC600=$G(@NODE)
  1.  I $P(REC600,U,2)="9002071.04PA" S $P(REC600,U,2)="9002071.06PA"
  1.  S NODE600=NEWNODE_",""D"","_ENTRYNUM_",600"_$S(ENTRYNUM=600:$P(NODE,"600,600",2,99),1:$P(NODE,",600",2,99))
  1.  S @NODE600=REC600
  1.  Q
  1. REC650 ;EP
  1.  S REC650=$G(@NODE)
  1.  S NODE500=NEWNODE_",""D"","_ENTRYNUM_",500,1,0)"
  1.  I $D(@NODE500) D
  1.  .S COM500=NEWNODE_",""D"","_ENTRYNUM_",500,1,1,0)"
  1.  .S COM500C=NEWNODE_",""D"","_ENTRYNUM_",500,1,1,1,0)"
  1.  .S @COM500=U_"9002071.53^1^1"
  1.  .S @COM500C=REC650
  1.  S NODE600=NEWNODE_",""D"","_ENTRYNUM_",600,1,0)"
  1.  I $D(@NODE600) D
  1.  .S COM600=NEWNODE_",""D"","_ENTRYNUM_",600,1,1,0)"
  1.  .S COM600C=NEWNODE_",""D"","_ENTRYNUM_",600,1,1,1,0)"
  1.  .S @COM600=U_"9002071.63^1^1"
  1.  .S @COM600C=REC650
  1.  Q
  1.  ;
  1. REC700 ;EP
  1.  S REC700=$G(@NODE)     ;CHANGE FROM 700 TO 800 FIELD GROUP
  1.  I $P(REC700,U,2)="9002071.06A" S $P(REC700,U,2)="9002071.08PA"
  1.  S NODE800=NEWNODE_",""D"","_ENTRYNUM_",800"_$S(ENTRYNUM=700:$P(NODE,"700,700",2,99),1:$P(NODE,",700",2,99))
  1.  S @NODE800=REC700
  1.  ;OLD PIECE ONE IS A FREE TEXT ENTRY AND MUST BE CHANGED TO A POINTER
  1.  S OLDFREE=$P(@NODE800,U)
  1.  ;FIND POSSIBLE INSURER USING OLD FREE TEXT ENTRY
  1.  S NEWPTR="",NAME=""
  1.  F  S NAME=$O(^AUTNINS("B",NAME)) Q:NAME=""  I NAME=OLDFREE S NEWPTR=NAME Q
  1.  I NEWPTR'="" S $P(@NODE800,U)=NEWPTR
  1.  Q
  1.  ;
  1. ERROR ;
  1.  S $ZT="ERRORH"
  1.  S ^ACHSINST(ACHSVERS,"ERROR",$ZN,"ERROR TRAP CALLED")=NOW
  1.  S XPDABORT=1
  1.  G ^%ET
  1.  ;
  1. ERRORCN ;
  1.  S $ZT="ERRORH"
  1.  D ERRREC
  1.  ;
  1.  I NEWNODE[(QT_"D"_QT),($P(NEWNODE,CM,3)'="") S NEWNEW=$P(NEWNODE,CM,1,3)_")" I NEWNEW'="" K @NEWNEW
  1.  S REC=$P($P(NODE,"(",2),CM,1)
  1.  S NODE="^ACHSDEN("_(REC+1)_")"
  1.  G LOOP1
  1.  ;
  1. ERRORXR ;
  1.  ;we get here if there is an error in creating the x-refs.
  1.  S $ZT="ERRORH"
  1.  D ERRREC
  1.  ;
  1.  G LOOP2A
  1.  ;
  1. ERRREC ;
  1.  ;record some info about this error before going on
  1.  S ERRNUM=+$O(^ACHSINST(ACHSVERS,"denial conversion","ERRORS",RUNTIME,""),-1)+1
  1.  S ^ACHSINST(ACHSVERS,"denial conversion","ERRORS",RUNTIME,ERRNUM,"$ZE")=$ZE
  1.  S ^ACHSINST(ACHSVERS,"denial conversion","ERRORS",RUNTIME,ERRNUM,"NODE")=$G(NODE)
  1.  S ^ACHSINST(ACHSVERS,"denial conversion","ERRORS",RUNTIME,ERRNUM,"NEWNODE")=$G(NEWNODE)
  1.  ;
  1.  S NUMERR=NUMERR+1
  1.  I NUMERR>500!(NUMENTRY>1000&(NUMERR/NUMENTRY*100>5)) S STOP=1
  1.  Q
  1.  ;
  1. ERRORH ;
  1.  G ^XUSCLEAN
  1.  ;